QAOC107 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;8/12/93  09:06
 ;;3.0;Occurrence Screen;;09/14/1993
 ;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,"^",3)'="J":1,$P(QAOSRF0,"^",12)'="I":1,1:0)
 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,"^",3)'="J":1,$P(QAOSRF0,"^",12)'="I":1,1:0)
 .. 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