QAOC109 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ; 6/9/14 12:57pm
;;3.0;Occurrence Screen;**8,9**;09/14/1993;Build 4
;SCREEN 109 -- DEATH
Q:$$INACTIVE^QAOC0(109)
N QAO109,QAO109F
F QAOSDOD=(QAMTODAY-1.0000001):0 S QAOSDOD=$O(^DGPM("ATT3",QAOSDOD)) Q:(QAOSDOD'>0)!(QAOSDOD>(QAMTODAY+.24))!(QAOSDOD\1'?7N) F QAOSD0=0:0 S QAOSD0=$O(^DGPM("ATT3",QAOSDOD,QAOSD0)) Q:QAOSD0'>0 D LOOP1
Q
LOOP1 ;
S QAOSZERO=$G(^DGPM(QAOSD0,0)) Q:QAOSZERO=""
S QAOSDFN=$P(QAOSZERO,"^",3),OUTYPE=$P(QAOSZERO,"^",18)
D LOOP2
Q:$G(QAO109F(QAOSDFN))
S OUTYPE=$P($G(^DG(405.2,+OUTYPE,0)),"^",8) Q:OUTYPE<6
N QAOENT
S QAOENT=$G(^QA(741,"AA",109,QAOSDOD,QAOSDFN)) Q:QAOENT'=""
D VADPT^QAOC0(QAOSDFN,QAOSD0)
S QAOVISIT=$P($G(^DGPM(+VAIP(13),0)),"^")
S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAOSDOD)=""
S WARDCLIN=+VAIP(5)_"^"
S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"WARD")=WARDCLIN
S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"TXSP")=+VAIP(8)
S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"MVDT")=QAOVISIT
S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"DIAG")=VAIP(9)
S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"AADM")=VAIP(13)
Q
LOOP2 ; Check if death was previously reported (QAO*3*9)
Q:$G(QAO109F(QAOSDFN))
S QAO109=""
F S QAO109=$O(^QA(741,"B",QAOSDFN,QAO109)) Q:QAO109="" D
. I $G(^QA(741,QAO109,"SCRN"))=109 S QAO109F(QAOSDFN)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOC109 1412 printed Oct 16, 2024@18:21:39 Page 2
QAOC109 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ; 6/9/14 12:57pm
+1 ;;3.0;Occurrence Screen;**8,9**;09/14/1993;Build 4
+2 ;SCREEN 109 -- DEATH
+3 if $$INACTIVE^QAOC0(109)
QUIT
+4 NEW QAO109,QAO109F
+5 FOR QAOSDOD=(QAMTODAY-1.0000001):0
SET QAOSDOD=$ORDER(^DGPM("ATT3",QAOSDOD))
if (QAOSDOD'>0)!(QAOSDOD>(QAMTODAY+.24))!(QAOSDOD\1'?7N)
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^DGPM("ATT3",QAOSDOD,QAOSD0))
if QAOSD0'>0
QUIT
DO LOOP1
+6 QUIT
LOOP1 ;
+1 SET QAOSZERO=$GET(^DGPM(QAOSD0,0))
if QAOSZERO=""
QUIT
+2 SET QAOSDFN=$PIECE(QAOSZERO,"^",3)
SET OUTYPE=$PIECE(QAOSZERO,"^",18)
+3 DO LOOP2
+4 if $GET(QAO109F(QAOSDFN))
QUIT
+5 SET OUTYPE=$PIECE($GET(^DG(405.2,+OUTYPE,0)),"^",8)
if OUTYPE<6
QUIT
+6 NEW QAOENT
+7 SET QAOENT=$GET(^QA(741,"AA",109,QAOSDOD,QAOSDFN))
if QAOENT'=""
QUIT
+8 DO VADPT^QAOC0(QAOSDFN,QAOSD0)
+9 SET QAOVISIT=$PIECE($GET(^DGPM(+VAIP(13),0)),"^")
+10 SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAOSDFN,QAOSDOD)=""
+11 SET WARDCLIN=+VAIP(5)_"^"
+12 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"WARD")=WARDCLIN
+13 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"TXSP")=+VAIP(8)
+14 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"MVDT")=QAOVISIT
+15 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"DIAG")=VAIP(9)
+16 SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAOSDOD,"AADM")=VAIP(13)
+17 QUIT
LOOP2 ; Check if death was previously reported (QAO*3*9)
+1 if $GET(QAO109F(QAOSDFN))
QUIT
+2 SET QAO109=""
+3 FOR
SET QAO109=$ORDER(^QA(741,"B",QAOSDFN,QAO109))
if QAO109=""
QUIT
Begin DoDot:1
+4 IF $GET(^QA(741,QAO109,"SCRN"))=109
SET QAO109F(QAOSDFN)=1
End DoDot:1
+5 QUIT
