47 lines
2.3 KiB
Mathematica
47 lines
2.3 KiB
Mathematica
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
|