| [613] | 1 | QAOC199 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;5/13/93 09:06
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | ;SCREEN 199 -- READMISSION TO ACUTE CARE WITHIN 48 HOURS OF DISCHARGE
|
|---|
| 4 | ; FROM EXTENDED CARE
|
|---|
| 5 | Q:$$INACTIVE^QAOC0(199)
|
|---|
| 6 | 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
|
|---|
| 7 | . F QAOSD0=0:0 S QAOSD0=$O(^DGPM("AMV1",QAOSDT,QAOSDFN,QAOSD0)) Q:QAOSD0'>0 D:$D(^DGPM(QAOSD0,0))#2 MAIN
|
|---|
| 8 | . Q
|
|---|
| 9 | Q
|
|---|
| 10 | MAIN ;
|
|---|
| 11 | D VADPT^QAOC0(QAOSDFN,QAOSD0) S QAOSDIAG=VAIP(9)
|
|---|
| 12 | Q:$$TXSP^QAOC0("AS",+VAIP(8))'>0
|
|---|
| 13 | S X1=QAOSDT,X2=-2 D C^%DTC S QAOSDCXX=9999999.9999999-X
|
|---|
| 14 | S QA=9999999.9999999-QAOSDT,QAOFOUND=0
|
|---|
| 15 | 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
|
|---|
| 16 | . Q:"^31^32^34^"'[("^"_$P($G(^DGPM(QAOSDCD0,0)),"^",18)_"^")
|
|---|
| 17 | . D VADPT^QAOC0(QAOSDFN,QAOSDCD0) S QAOFOUND=1
|
|---|
| 18 | . S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
|
|---|
| 19 | . S WARDCLIN=+VAIP(5)_"^"
|
|---|
| 20 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=WARDCLIN
|
|---|
| 21 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)
|
|---|
| 22 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=+VAIP(3)
|
|---|
| 23 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=QAOSDIAG
|
|---|
| 24 | . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=QAOSD0
|
|---|
| 25 | . Q
|
|---|
| 26 | Q
|
|---|
