AHIEH02A ;NC/RLP Update Existing Non-compliant Entries 19-Mar-02
;v1.5
;;
TST S RLP="U" D ^AHIEH01 Q
TST1 S RLP="V" D ^AHIEH01 Q
Q
;
;
EN D EN^DDIOL(,,"!!")
I AHITEST=4 S TESTNAME="TB Test"
I AHITEST=3 S TESTNAME="Chest X-ray"
;
; --- find last non-compliant test
S SCREEN="I $P(^(0),""^"",14)=18,$P(^(0),""^"",3)=AHITEST"
;S SCREEN="I $P(^(0),""^"",3)=AHITEST"
S FILENUM=556058
K OUT D FIND^DIC(FILENUM,,"@;.01IE",,NAM,,"E",SCREEN,,"OUT")
S LSTENTRY=$P(OUT("DILIST",0),U,1)
;
; --- is there a non-compliant test to update?
NO I LSTENTRY'>0 D ;
. D EN^DDIOL("NO Non-compliant "_TESTNAME_"s to Update for this Fiscal Y
ear!",,"!?5")
. D EN^DDIOL(,,"!")
;
YES E D ;
. S IEN=$P(OUT("DILIST",2,LSTENTRY),"^",1)
. S DATEEXT=$P(OUT("DILIST","ID",LSTENTRY,.01,"E"),"@",1)
. S DATEINT=$P(OUT("DILIST","ID",LSTENTRY,.01,"I"),".",1)
. S DATEFY=$P($$FY^AHIEH02B(DATEINT)," ",1)
. S DATECRNT=$P($$FY^AHIEH02B(DT)," ",1)
. ; --- display findings
. ; IDATECRNT'=DATEFY D ;
. ; . D EN^DDIOL("NO Non-Compliant "_TESTNAME_"s to Update for this Fisc
al Year!",,"!?5")
. ; . ;
OUTPUT . E D ;
. . D EN^DDIOL("Last Non-Compliant "_TESTNAME_": "_DATEEXT,,"?5")
. . D EN^DDIOL("Fiscal Year: "_DATEFY,,"!?20")
. . D EN^DDIOL(,,"!")
. . S DIE=FILENUM,DA=IEN,DR="3;10;12;17" D ^DIE