source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOC107.m@ 949

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1QAOC107 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;8/12/93 09:06
2 ;;3.0;Occurrence Screen;;09/14/1993
3 ;SCREEN 107 -- RETURN TO THE O.R. IN THE SAME ADMISSION (SURGERY V3.0)
4 Q:$$INACTIVE^QAOC0(107) Q:$P($G(^QA(740,1,"OS")),"^",7)'>0
5 K QAOSFALL
6 F QAOSDT=QAMTODAY-.0000001:0 S QAOSDT=$O(^SRF("AC",QAOSDT)) Q:(QAOSDT'>0)!(QAOSDT>(QAMTODAY+.24))!(QAOSDT\1'?7N) F QAOSRFD0=0:0 S QAOSRFD0=$O(^SRF("AC",QAOSDT,QAOSRFD0)) Q:QAOSRFD0'>0 D MAIN
7 K %Y,DFN,QAOSADM,QAOSCHED,QAOSDFN,QAOSDT,QAOSDTP,QAOSFALL,QAOSRF0
8 K QAOSRF30,QAOSRF31,QAOSRFD0,QAOSRFDA,QAOSVAIP,X,X1,X2
9 K ^UTILITY($J,"QAM TEMP") D KVAR^VADPT
10 Q
11MAIN ;
12 S QAOSRF0=$G(^SRF(QAOSRFD0,0)),QAOSDFN=+QAOSRF0
13 Q:$S(QAOSDFN'>0:1,$D(QAOSFALL(QAOSDFN))#2:1,1:0)
14 Q:$S($P(QAOSRF0,"^",3)'="J":1,$P(QAOSRF0,"^",12)'="I":1,1:0)
15 S QAOSRF30=$G(^SRF(QAOSRFD0,30)),QAOSRF31=$G(^(31))
16 Q:$S($P(QAOSRF30,"^"):1,$P(QAOSRF31,"^",8):1,1:0)
17 S QAOSCHED=$P(QAOSRF31,"^",4)
18 K VAIP S DFN=QAOSDFN,VAIP("D")=QAOSDT\1,VAIP("M")=0 D IN5^VADPT
19 S QAOSVAIP(1)=VAIP(1),QAOSVAIP(9)=VAIP(9)
20 S QAOSADM=+VAIP(3)\1 Q:QAOSADM'>0
21 S X1=QAOSDT\1,X2=QAOSADM D ^%DTC
22 I X>7 S X1=QAOSDT\1,X2=-7 D C^%DTC S QAOSADM=X
23 ;
24 S QAOSDTP=9999999-QAOSDT-.0000001,QAOSQUIT=0
25 F QAOSDTP=QAOSDTP:0 S QAOSDTP=$O(^SRF("ADT",QAOSDFN,QAOSDTP)) Q:(QAOSDTP'>0)!(QAOSDTP\1'?7N)!QAOSQUIT D
26 . F QAOSRFDA=0:0 S QAOSRFDA=$O(^SRF("ADT",QAOSDFN,QAOSDTP,QAOSRFDA)) Q:(QAOSRFDA'>0)!(QAOSRFDA=QAOSRFD0)!QAOSQUIT D
27 .. S QAOSRF0=$G(^SRF(QAOSRFDA,0))
28 .. S QAOSDTP(0)=$P(QAOSRF0,"^",9)
29 .. I (QAOSDTP(0)<QAOSADM)!(QAOSDTP(0)'<QAOSDT) S QAOSQUIT=1 Q
30 .. Q:$S($P(QAOSRF0,"^",3)'="J":1,$P(QAOSRF0,"^",12)'="I":1,1:0)
31 .. S QAOSRF30(0)=$G(^SRF(QAOSRFD0,30)),QAOSRF31(0)=$G(^(31))
32 .. Q:$S($P(QAOSRF30(0),"^"):1,$P(QAOSRF31(0),"^",8):1,1:0)
33 .. I QAOSCHED,QAOSCHED\1'>(QAOSDTP(0)\1) Q
34 .. I $P($G(^SRF(QAOSRFDA,29,QAOSRFD0,0)),"^",3)'="R" Q
35 .. K VAIP S DFN=QAOSDFN,VAIP("D")=QAOSDTP(0)\1,VAIP("M")=0
36 .. D IN5^VADPT
37 .. S (QAOSFALL(QAOSDFN),QAOSQUIT)=1
38 .. S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
39 .. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=+VAIP(5)
40 .. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)
41 .. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=QAOSDTP(0)
42 .. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=QAOSVAIP(9)
43 .. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=+QAOSVAIP(1)
44 .. Q
45 . Q
46 Q
Note: See TracBrowser for help on using the repository browser.