source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOC199.m@ 1789

Last change on this file since 1789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1QAOC199 ;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
10MAIN ;
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
Note: See TracBrowser for help on using the repository browser.