QAOC109.m

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 ---QAOC109   1412     printed  Apr 09, 2024@21:22:33                                                                                                                                                                                                     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