QAOC107 ;HISC/DAD - OCCURRENCE SCREEN AUTO ENROLLMENT ;8/12/93 09:06
;;3.0;Occurrence Screen;**10**;09/14/1993;Build 5
;SCREEN 107 -- RETURN TO THE O.R. IN THE SAME ADMISSION (SURGERY V3.0)
Q:$$INACTIVE^QAOC0(107) Q:$P($G(^QA(740,1,"OS")),"^",7)'>0
K QAOSFALL
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
K %Y,DFN,QAOSADM,QAOSCHED,QAOSDFN,QAOSDT,QAOSDTP,QAOSFALL,QAOSRF0
K QAOSRF30,QAOSRF31,QAOSRFD0,QAOSRFDA,QAOSVAIP,X,X1,X2
K ^UTILITY($J,"QAM TEMP") D KVAR^VADPT
Q
MAIN ;
S QAOSRF0=$G(^SRF(QAOSRFD0,0)),QAOSDFN=+QAOSRF0
Q:$S(QAOSDFN'>0:1,$D(QAOSFALL(QAOSDFN))#2:1,1:0)
Q:$S($P(QAOSRF0,U,12)="":1,$P(QAOSRF0,U,12)="O":1,1:0) ;QAO*3.0*10 - updated due to surgery enhancements
S QAOSRF30=$G(^SRF(QAOSRFD0,30)),QAOSRF31=$G(^(31))
Q:$S($P(QAOSRF30,"^"):1,$P(QAOSRF31,"^",8):1,1:0)
S QAOSCHED=$P(QAOSRF31,"^",4)
K VAIP S DFN=QAOSDFN,VAIP("D")=QAOSDT\1,VAIP("M")=0 D IN5^VADPT
S QAOSVAIP(1)=VAIP(1),QAOSVAIP(9)=VAIP(9)
S QAOSADM=+VAIP(3)\1 Q:QAOSADM'>0
S X1=QAOSDT\1,X2=QAOSADM D ^%DTC
I X>7 S X1=QAOSDT\1,X2=-7 D C^%DTC S QAOSADM=X
;
S QAOSDTP=9999999-QAOSDT-.0000001,QAOSQUIT=0
F QAOSDTP=QAOSDTP:0 S QAOSDTP=$O(^SRF("ADT",QAOSDFN,QAOSDTP)) Q:(QAOSDTP'>0)!(QAOSDTP\1'?7N)!QAOSQUIT D
. F QAOSRFDA=0:0 S QAOSRFDA=$O(^SRF("ADT",QAOSDFN,QAOSDTP,QAOSRFDA)) Q:(QAOSRFDA'>0)!(QAOSRFDA=QAOSRFD0)!QAOSQUIT D
.. S QAOSRF0=$G(^SRF(QAOSRFDA,0))
.. S QAOSDTP(0)=$P(QAOSRF0,"^",9)
.. I (QAOSDTP(0)<QAOSADM)!(QAOSDTP(0)'<QAOSDT) S QAOSQUIT=1 Q
.. Q:$S($P(QAOSRF0,U,12)="":1,$P(QAOSRF0,U,12)="O":1,1:0) ;QAO*3.0*10 - updated due to surgery enhancements
.. S QAOSRF30(0)=$G(^SRF(QAOSRFD0,30)),QAOSRF31(0)=$G(^(31))
.. Q:$S($P(QAOSRF30(0),"^"):1,$P(QAOSRF31(0),"^",8):1,1:0)
.. I QAOSCHED,QAOSCHED\1'>(QAOSDTP(0)\1) Q
.. I $P($G(^SRF(QAOSRFDA,29,QAOSRFD0,0)),"^",3)'="R" Q
.. K VAIP S DFN=QAOSDFN,VAIP("D")=QAOSDTP(0)\1,VAIP("M")=0
.. D IN5^VADPT
.. S (QAOSFALL(QAOSDFN),QAOSQUIT)=1
.. S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
.. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=+VAIP(5)
.. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)
.. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=QAOSDTP(0)
.. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=QAOSVAIP(9)
.. S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=+QAOSVAIP(1)
.. Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOC107 2545 printed Nov 22, 2024@17:31:01 Page 2
QAOC107 ;HISC/DAD - OCCURRENCE SCREEN AUTO ENROLLMENT ;8/12/93 09:06
+1 ;;3.0;Occurrence Screen;**10**;09/14/1993;Build 5
+2 ;SCREEN 107 -- RETURN TO THE O.R. IN THE SAME ADMISSION (SURGERY V3.0)
+3 if $$INACTIVE^QAOC0(107)
QUIT
if $PIECE($GET(^QA(740,1,"OS")),"^",7)'>0
QUIT
+4 KILL QAOSFALL
+5 FOR QAOSDT=QAMTODAY-.0000001:0
SET QAOSDT=$ORDER(^SRF("AC",QAOSDT))
if (QAOSDT'>0)!(QAOSDT>(QAMTODAY+.24))!(QAOSDT\1'?7N)
QUIT
FOR QAOSRFD0=0:0
SET QAOSRFD0=$ORDER(^SRF("AC",QAOSDT,QAOSRFD0))
if QAOSRFD0'>0
QUIT
DO MAIN
+6 KILL %Y,DFN,QAOSADM,QAOSCHED,QAOSDFN,QAOSDT,QAOSDTP,QAOSFALL,QAOSRF0
+7 KILL QAOSRF30,QAOSRF31,QAOSRFD0,QAOSRFDA,QAOSVAIP,X,X1,X2
+8 KILL ^UTILITY($JOB,"QAM TEMP")
DO KVAR^VADPT
+9 QUIT
MAIN ;
+1 SET QAOSRF0=$GET(^SRF(QAOSRFD0,0))
SET QAOSDFN=+QAOSRF0
+2 if $SELECT(QAOSDFN'>0
QUIT
+3 ;QAO*3.0*10 - updated due to surgery enhancements
if $SELECT($PIECE(QAOSRF0,U,12)=""
QUIT
+4 SET QAOSRF30=$GET(^SRF(QAOSRFD0,30))
SET QAOSRF31=$GET(^(31))
+5 if $SELECT($PIECE(QAOSRF30,"^")
QUIT
+6 SET QAOSCHED=$PIECE(QAOSRF31,"^",4)
+7 KILL VAIP
SET DFN=QAOSDFN
SET VAIP("D")=QAOSDT\1
SET VAIP("M")=0
DO IN5^VADPT
+8 SET QAOSVAIP(1)=VAIP(1)
SET QAOSVAIP(9)=VAIP(9)
+9 SET QAOSADM=+VAIP(3)\1
if QAOSADM'>0
QUIT
+10 SET X1=QAOSDT\1
SET X2=QAOSADM
DO ^%DTC
+11 IF X>7
SET X1=QAOSDT\1
SET X2=-7
DO C^%DTC
SET QAOSADM=X
+12 ;
+13 SET QAOSDTP=9999999-QAOSDT-.0000001
SET QAOSQUIT=0
+14 FOR QAOSDTP=QAOSDTP:0
SET QAOSDTP=$ORDER(^SRF("ADT",QAOSDFN,QAOSDTP))
if (QAOSDTP'>0)!(QAOSDTP\1'?7N)!QAOSQUIT
QUIT
Begin DoDot:1
+15 FOR QAOSRFDA=0:0
SET QAOSRFDA=$ORDER(^SRF("ADT",QAOSDFN,QAOSDTP,QAOSRFDA))
if (QAOSRFDA'>0)!(QAOSRFDA=QAOSRFD0)!QAOSQUIT
QUIT
Begin DoDot:2
+16 SET QAOSRF0=$GET(^SRF(QAOSRFDA,0))
+17 SET QAOSDTP(0)=$PIECE(QAOSRF0,"^",9)
+18 IF (QAOSDTP(0)<QAOSADM)!(QAOSDTP(0)'<QAOSDT)
SET QAOSQUIT=1
QUIT
+19 ;QAO*3.0*10 - updated due to surgery enhancements
if $SELECT($PIECE(QAOSRF0,U,12)=""
QUIT
+20 SET QAOSRF30(0)=$GET(^SRF(QAOSRFD0,30))
SET QAOSRF31(0)=$GET(^(31))
+21 if $SELECT($PIECE(QAOSRF30(0),"^")
QUIT
+22 IF QAOSCHED
IF QAOSCHED\1'>(QAOSDTP(0)\1)
QUIT
+23 IF $PIECE($GET(^SRF(QAOSRFDA,29,QAOSRFD0,0)),"^",3)'="R"
QUIT
+24 KILL VAIP
SET DFN=QAOSDFN
SET VAIP("D")=QAOSDTP(0)\1
SET VAIP("M")=0
+25 DO IN5^VADPT
+26 SET (QAOSFALL(QAOSDFN),QAOSQUIT)=1
+27 SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""
+28 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=+VAIP(5)
+29 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)
+30 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=QAOSDTP(0)
+31 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=QAOSVAIP(9)
+32 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=+QAOSVAIP(1)
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 QUIT
