27 lines
1.5 KiB
Mathematica
27 lines
1.5 KiB
Mathematica
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
|