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