AHIEH04A ;NC/RLP Find Last Mantoux and Chest X-Ray test 22-Mar-02 ;v1.5 ;; ; --- find last mantoux and chest x-ray test EN(EMPLOYEE) ; N DATEEXT,DATEFY,DATEINT,FILENUM,IEN,LSTENTRY,RESULT,SCREEN ; S SCREEN="I $P(^(0),""^"",3)=AHITEST" S FILENUM=556058 K OUT D FIND^DIC(FILENUM,,"@;.01IE",,EMPLOYEE,,"E",SCREEN,,"OUT") S LSTENTRY=$P(OUT("DILIST",0),U,1) ; ; --- is there a test? YES I LSTENTRY>0 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 RESULT=DATEFY NO E S RESULT="" K OUT Q RESULT