QAOC199 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;5/13/93  09:06
 ;;3.0;Occurrence Screen;;09/14/1993
 ;SCREEN 199 -- READMISSION TO ACUTE CARE WITHIN 48 HOURS OF DISCHARGE
 ;              FROM EXTENDED CARE
 Q:$$INACTIVE^QAOC0(199)
 F QAOSDT=(QAMTODAY-.0000001):0 S QAOSDT=$O(^DGPM("AMV1",QAOSDT)) Q:QAOSDT'>0!(QAOSDT>(QAMTODAY+.24))!(QAOSDT\1'?7N)  F QAOSDFN=0:0 S QAOSDFN=$O(^DGPM("AMV1",QAOSDT,QAOSDFN)) Q:QAOSDFN'>0  D
 . F QAOSD0=0:0 S QAOSD0=$O(^DGPM("AMV1",QAOSDT,QAOSDFN,QAOSD0)) Q:QAOSD0'>0  D:$D(^DGPM(QAOSD0,0))#2 MAIN
 . Q
 Q
MAIN ;
 D VADPT^QAOC0(QAOSDFN,QAOSD0) S QAOSDIAG=VAIP(9)
 Q:$$TXSP^QAOC0("AS",+VAIP(8))'>0
 S X1=QAOSDT,X2=-2 D C^%DTC S QAOSDCXX=9999999.9999999-X
 S QA=9999999.9999999-QAOSDT,QAOFOUND=0
 F QAOSDCDT=QA:0 S QAOSDCDT=$O(^DGPM("ATID3",QAOSDFN,QAOSDCDT)) Q:(QAOSDCDT'>0)!(QAOSDCDT>QAOSDCXX)!(QAOSDCDT\1'?7N)!QAOFOUND  F QAOSDCD0=0:0 S QAOSDCD0=$O(^DGPM("ATID3",QAOSDFN,QAOSDCDT,QAOSDCD0)) Q:QAOSDCD0'>0!QAOFOUND  D
 . Q:"^31^32^34^"'[("^"_$P($G(^DGPM(QAOSDCD0,0)),"^",18)_"^")
 . D VADPT^QAOC0(QAOSDFN,QAOSDCD0) S QAOFOUND=1
 . S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
 . S WARDCLIN=+VAIP(5)_"^"
 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=WARDCLIN
 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)
 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=+VAIP(3)
 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=QAOSDIAG
 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=QAOSD0
 . Q
 Q