APCM24CI.m

APCM24CI ;IHS/CMI/LAB - MU REPORT;

 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

 ;

CALCIND ;EP - CALCULATE ALL MEASURES

 ;for this patient get all of their visits in the EHR reporting period and save in APCMVSTS for use in all measures

 K APCMVSTS,APCMHVTP,APCMPEVT

 D ALLV^APCLAPIU(DFN,APCMBDAT,APCMEDAT,"APCMVSTS")

 I APCMRPTT=1 S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D

 .K APCMSC

 .F X="A","O","M","S" S APCMSC(X)=""

 .S APCMHV=$$HADV(DFN,APCMP,APCMBDAT,APCMEDAT,.APCMVSTS,.APCMSC)

 .I APCMHV S APCMHVTP(APCMP)=APCMHV

 .K APCMSC

 .F X="A","O","S" S APCMSC(X)=""

 .S APCMPEHV=$$HADV(DFN,APCMP,APCMBDAT,APCMEDAT,.APCMVSTS,.APCMSC)

 .I APCMPEHV S APCMPEVT(APCMP)=APCMPEHV

 .K APCMSC

 ;all measures except attestation and non-patient

 I APCMRPTT=2 D

 .S APCMHV=$$HADVH(DFN,APCMFAC,APCMBDAT,APCMEDAT,.APCMVSTS,APCMMETH) I APCMHV S APCMHVTP(APCMFAC)=APCMHV

 .S APCMVDOD=$$VDOD(DFN,APCMFAC,APCMBDAT,APCMEDAT,.APCMVSTS)  ;did patient have an H visit with Death as discharge type

 S APCMIC=0 F  S APCMIC=$O(APCMIND(APCMIC)) Q:APCMIC'=+APCMIC  D

 .Q:$P(^APCM24OB(APCMIC,0),U,6)="A"

 .Q:$P(^APCM24OB(APCMIC,0),U,12)=0

 .K APCMSTOP,APCMVAL,APCMVALU,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 .S APCMVALU=""

 .I $D(^APCM24OB(APCMIC,1)) X ^APCM24OB(APCMIC,1)

 Q

CALCINDA ;EP - CALCULATE ATTESTATION MEASURES

 S APCMIC=0 F  S APCMIC=$O(APCMIND(APCMIC)) Q:APCMIC'=+APCMIC  D

 .;Q:$P(^APCM24OB(APCMIC,0),U,6)="R"

 .Q:$P(^APCM24OB(APCMIC,0),U,12)=1

 .K APCMSTOP,APCMVAL,APCMVALU,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z,APCMVALU

 .K APCMN1,APCMD1

 .S APCMVALU=""

 .I $D(^APCM24OB(APCMIC,1)) X ^APCM24OB(APCMIC,1)

 Q

S1(BQITYP,BQIVAL) ; Return data by patient for iCare into global reference BQIGREF

 ;Input Variables

 ;  BQITYP - Type of value

 ;           D = Denominator

 ;           N = Numerator

 ;  BQIVAL - Value of the type; 0 or 1

 ;Assumed variables

 ;  APCMVALUE - the measure value

 ;  BQIGREF  - global reference where data will be stored temporarily

 ;  APCMIC    - Indicator IEN

 ;  APCMI     - Individual Indicator IEN

 ;  DFN      - Patient IEN

 ;

 ; If no value of BQIGREF, then it's the regular GPRA report calling the code

 ; and nothing needs to be set for iCare.

 Q:$G(BQIGREF)=""

 ;

 ; If no denominator or numerator value, then it doesn't need to be set for iCare

 I '$G(BQIVAL) Q

 ;

 NEW BQITIT,BQILTIT,BQILTIT1,BQILTIT2,BQILTIT3,BQILDTI1,BQILDTI2

 NEW BQIDTIT,BQIFTIT,BQITWEN,BQICURR,BQIIDTA,BQIDTA,BQILDTI3

 S BQIIDTA=$G(^APCM24OB(APCMI,0))

 S BQIDTA=$G(^APCM24OB(APCMI,14))

 ;

 ; Get the Individual Indicator TITLE (1404) 

 S BQITIT=$P(BQIDTA,U,4)

 ;

 ; Get the Individual Indicator LINE TITLE 1 (.15)

 S BQILTIT1=$P(BQIIDTA,U,15)

 I BQILTIT1="" Q

 ; Get the Individual Indicator LINE TITLE 2 and 3 (.16,.19) 

 S BQILTIT2=$P(BQIIDTA,U,16)

 S BQILTIT3=$P(BQIIDTA,U,19)

 S BQILTIT=BQILTIT1_" "_BQILTIT2_" "_BQILTIT3

 ;

 ; Get the Individual Indicator LOCAL DENOM TITLE 1, 2, and 3 (.17,.18,.21)

 S BQILDTI1=$P(BQIIDTA,U,17)

 S BQILDTI2=$P(BQIIDTA,U,18)

 S BQILDTI3=$P(BQIIDTA,U,21)

 S BQIDTIT=BQILDTI1_" "_BQILDTI2_" "_BQILDTI3

 ;

 ;  Full title is all title fields

 S BQIFTIT=BQITIT_" "_BQILTIT_" "_BQIDTIT

 S $P(@BQIGREF@(DFN,APCMIC,APCMI),"^",1)=BQIFTIT

 ;

 ;  Get the GOAL 2014 value and the GOAL 06 value

 S BQITWEN=$P(BQIDTA,U,3)

 S BQICURR=$P(BQIDTA,U,8)

 ;

 I BQITYP="N" S $P(@BQIGREF@(DFN,APCMIC,APCMI),"^",2)=$G(BQIVAL)

 ;

 I BQITYP="D" S $P(@BQIGREF@(DFN,APCMIC,APCMI),"^",3)=$G(BQIVAL)

 ;

 ;  Set the Indicator TITLE (.03)

 S $P(@BQIGREF@(DFN,APCMIC),U,1)=$P(^APCM24OB(APCMIC,0),U,3)

 S $P(@BQIGREF@(DFN,APCMIC),U,2)=$G(APCMVALU)

 I BQITWEN'="" S $P(@BQIGREF@(DFN,APCMIC),U,3)=BQITWEN

 I BQICURR'="" S $P(@BQIGREF@(DFN,APCMIC),U,4)=BQICURR

 Q

HADV(P,R,BD,ED,VSTS,SC) ;EP - had visit of A, O, R, S with provider R in time frame BD-ED

 ;PATCH 1 excludes ER and case management clinics

 ;patch 1 provider must be primary only

 ; so, in summary, the patient must have at least 1 A,O,R,M, non-ER, non-case man visit

 ; where this provider is the primary provider

 I '$G(P) Q ""

 I '$G(R) Q ""

 I '$G(BD) Q ""

 I '$G(ED) Q ""

 I '$D(^AUPNPAT(P,0)) Q ""

 I '$D(^VA(200,R,0)) Q ""

 NEW V,X,Y,G,S

 S G=""

 S X=0 F  S X=$O(VSTS(X)) Q:X'=+X!(G)  D

 .S V=$P(VSTS(X),U,5)

 .I '$D(^AUPNVSIT(V,0)) Q

 .I $P(^AUPNVSIT(V,0),U,11) Q  ;deleted

 .;I "AOSM"'[$P(^AUPNVSIT(V,0),U,7) Q  ;not correct service category

 .S S=$P(^AUPNVSIT(V,0),U,7)

 .Q:S=""  ;no service category

 .Q:'$D(SC(S))

 .S C=$$CLINIC^APCLV(V,"C")

 .I C=30 Q  ;no ER per Carmen patch 1

 .I C=77 Q  ;no case management clinic 77 per Chris

 .I C=76 Q  ;no lab

 .I C=63 Q  ;no radiology

 .I C=39 Q  ;no pharmacy

 .S Y=$$PRIMPROV^APCLV(V,"I")

 .I 'Y Q

 .I Y'=R Q  ;not this provider

 .;S Y=0 F  S Y=$O(^AUPNVPRV("AD",V,Y)) Q:Y'=+Y!(G)  D

 .;.I $P($G(^AUPNVPRV(Y,0)),U)'=R Q

 .S G=$$VD^APCLV(V)

 Q G  ;quit on the date of the visit

 ;

HADVH(P,R,BD,ED,VSTS,APCMMETH) ;EP - had visit H or ER A,O,S,M

 I '$G(P) Q ""

 I '$G(R) Q ""

 I '$G(BD) Q ""

 I '$G(ED) Q ""

 I '$D(^AUPNPAT(P,0)) Q ""

 I '$D(^DIC(4,R,0)) Q ""

 NEW V,X,Y,G,C

 S G=""

 S X=0 F  S X=$O(VSTS(X)) Q:X'=+X!(G)  D

 .S V=$P(VSTS(X),U,5)

 .I '$D(^AUPNVSIT(V,0)) Q

 .I $P(^AUPNVSIT(V,0),U,11) Q  ;deleted

 .I $P(^AUPNVSIT(V,0),U,6)'=R Q  ;not correct facility

 .I $P(^AUPNVSIT(V,0),U,7)="H" S G=$$VD^APCLV(V) Q

 .I APCMMETH="O",$P(^AUPNVSIT(V,0),U,7)="O" S G=$$VD^APCLV(V) Q

 .Q:APCMMETH="O"

 .I $P(^AUPNVSIT(V,0),U,7)'="A" Q  ;not correct service category

 .S C=$$CLINIC^APCLV(V,"C")

 .I C'=30 Q

 .S G=$$VD^APCLV(V)

 Q G  ;quit on the date of the visit

VDOD(P,R,BD,ED,VSTS) ;EP - had visit H or ER A,O,S,M

 I '$G(P) Q ""

 I '$G(R) Q ""

 I '$G(BD) Q ""

 I '$G(ED) Q ""

 I '$D(^AUPNPAT(P,0)) Q ""

 I '$D(^DIC(4,R,0)) Q ""

 NEW V,X,Y,G,C,H,D

 S G=""

 S X=0 F  S X=$O(^AUPNVINP("AC",P,X)) Q:X'=+X!(G)  D

 .S V=$P($G(^AUPNVINP(X,0)),U,3)

 .Q:'V

 .I '$D(^AUPNVSIT(V,0)) Q

 .I $P(^AUPNVSIT(V,0),U,11) Q  ;deleted

 .I $P(^AUPNVSIT(V,0),U,6)'=R Q  ;not correct facility

 .I $P(^AUPNVSIT(V,0),U,7)'="H" Q

 .;get discharge type

 .S D=$$VAL^XBDIQ1(9000010.02,X,.06)

 .I D["DEATH" S G=X

 .;I $$VAL^XBDIQ1(9000010.02,H,6102)="EXPIRED"

 Q G  ;quit on the IEN OF THE V HOSP

APCM24CI  ;IHS/CMI/LAB - MU REPORT;

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

 +2       ;

CALCIND   ;EP - CALCULATE ALL MEASURES

 +1       ;for this patient get all of their visits in the EHR reporting period and save in APCMVSTS for use in all measures

 +2        KILL APCMVSTS,APCMHVTP,APCMPEVT

 +3        DO ALLV^APCLAPIU(DFN,APCMBDAT,APCMEDAT,"APCMVSTS")

 +4        IF APCMRPTT=1

               SET APCMP=0

               FOR 

                   SET APCMP=$ORDER(APCMPRV(APCMP))

                   IF APCMP'=+APCMP

                       QUIT 

                   Begin DoDot:1

 +5                    KILL APCMSC

 +6                    FOR X="A","O","M","S"

                           SET APCMSC(X)=""

 +7                    SET APCMHV=$$HADV(DFN,APCMP,APCMBDAT,APCMEDAT,.APCMVSTS,.APCMSC)

 +8                    IF APCMHV

                           SET APCMHVTP(APCMP)=APCMHV

 +9                    KILL APCMSC

 +10                   FOR X="A","O","S"

                           SET APCMSC(X)=""

 +11                   SET APCMPEHV=$$HADV(DFN,APCMP,APCMBDAT,APCMEDAT,.APCMVSTS,.APCMSC)

 +12                   IF APCMPEHV

                           SET APCMPEVT(APCMP)=APCMPEHV

 +13                   KILL APCMSC

                   End DoDot:1

 +14      ;all measures except attestation and non-patient

 +15       IF APCMRPTT=2

               Begin DoDot:1

 +16               SET APCMHV=$$HADVH(DFN,APCMFAC,APCMBDAT,APCMEDAT,.APCMVSTS,APCMMETH)

                   IF APCMHV

                       SET APCMHVTP(APCMFAC)=APCMHV

 +17      ;did patient have an H visit with Death as discharge type

                   SET APCMVDOD=$$VDOD(DFN,APCMFAC,APCMBDAT,APCMEDAT,.APCMVSTS)

               End DoDot:1

 +18       SET APCMIC=0

           FOR 

               SET APCMIC=$ORDER(APCMIND(APCMIC))

               IF APCMIC'=+APCMIC

                   QUIT 

               Begin DoDot:1

 +19               IF $PIECE(^APCM24OB(APCMIC,0),U,6)="A"

                       QUIT 

 +20               IF $PIECE(^APCM24OB(APCMIC,0),U,12)=0

                       QUIT 

 +21               KILL APCMSTOP,APCMVAL,APCMVALU,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z

 +22               SET APCMVALU=""

 +23               IF $DATA(^APCM24OB(APCMIC,1))

                       XECUTE ^APCM24OB(APCMIC,1)

               End DoDot:1

 +24       QUIT 

CALCINDA  ;EP - CALCULATE ATTESTATION MEASURES

 +1        SET APCMIC=0

           FOR 

               SET APCMIC=$ORDER(APCMIND(APCMIC))

               IF APCMIC'=+APCMIC

                   QUIT 

               Begin DoDot:1

 +2       ;Q:$P(^APCM24OB(APCMIC,0),U,6)="R"

 +3                IF $PIECE(^APCM24OB(APCMIC,0),U,12)=1

                       QUIT 

 +4                KILL APCMSTOP,APCMVAL,APCMVALU,A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R,S,T,V,W,X,Y,Z,APCMVALU

 +5                KILL APCMN1,APCMD1

 +6                SET APCMVALU=""

 +7                IF $DATA(^APCM24OB(APCMIC,1))

                       XECUTE ^APCM24OB(APCMIC,1)

               End DoDot:1

 +8        QUIT 

S1(BQITYP,BQIVAL) ; Return data by patient for iCare into global reference BQIGREF

 +1       ;Input Variables

 +2       ;  BQITYP - Type of value

 +3       ;           D = Denominator

 +4       ;           N = Numerator

 +5       ;  BQIVAL - Value of the type; 0 or 1

 +6       ;Assumed variables

 +7       ;  APCMVALUE - the measure value

 +8       ;  BQIGREF  - global reference where data will be stored temporarily

 +9       ;  APCMIC    - Indicator IEN

 +10      ;  APCMI     - Individual Indicator IEN

 +11      ;  DFN      - Patient IEN

 +12      ;

 +13      ; If no value of BQIGREF, then it's the regular GPRA report calling the code

 +14      ; and nothing needs to be set for iCare.

 +15       IF $GET(BQIGREF)=""

               QUIT 

 +16      ;

 +17      ; If no denominator or numerator value, then it doesn't need to be set for iCare

 +18       IF '$GET(BQIVAL)

               QUIT 

 +19      ;

 +20       NEW BQITIT,BQILTIT,BQILTIT1,BQILTIT2,BQILTIT3,BQILDTI1,BQILDTI2

 +21       NEW BQIDTIT,BQIFTIT,BQITWEN,BQICURR,BQIIDTA,BQIDTA,BQILDTI3

 +22       SET BQIIDTA=$GET(^APCM24OB(APCMI,0))

 +23       SET BQIDTA=$GET(^APCM24OB(APCMI,14))

 +24      ;

 +25      ; Get the Individual Indicator TITLE (1404) 

 +26       SET BQITIT=$PIECE(BQIDTA,U,4)

 +27      ;

 +28      ; Get the Individual Indicator LINE TITLE 1 (.15)

 +29       SET BQILTIT1=$PIECE(BQIIDTA,U,15)

 +30       IF BQILTIT1=""

               QUIT 

 +31      ; Get the Individual Indicator LINE TITLE 2 and 3 (.16,.19) 

 +32       SET BQILTIT2=$PIECE(BQIIDTA,U,16)

 +33       SET BQILTIT3=$PIECE(BQIIDTA,U,19)

 +34       SET BQILTIT=BQILTIT1_" "_BQILTIT2_" "_BQILTIT3

 +35      ;

 +36      ; Get the Individual Indicator LOCAL DENOM TITLE 1, 2, and 3 (.17,.18,.21)

 +37       SET BQILDTI1=$PIECE(BQIIDTA,U,17)

 +38       SET BQILDTI2=$PIECE(BQIIDTA,U,18)

 +39       SET BQILDTI3=$PIECE(BQIIDTA,U,21)

 +40       SET BQIDTIT=BQILDTI1_" "_BQILDTI2_" "_BQILDTI3

 +41      ;

 +42      ;  Full title is all title fields

 +43       SET BQIFTIT=BQITIT_" "_BQILTIT_" "_BQIDTIT

 +44       SET $PIECE(@BQIGREF@(DFN,APCMIC,APCMI),"^",1)=BQIFTIT

 +45      ;

 +46      ;  Get the GOAL 2014 value and the GOAL 06 value

 +47       SET BQITWEN=$PIECE(BQIDTA,U,3)

 +48       SET BQICURR=$PIECE(BQIDTA,U,8)

 +49      ;

 +50       IF BQITYP="N"

               SET $PIECE(@BQIGREF@(DFN,APCMIC,APCMI),"^",2)=$GET(BQIVAL)

 +51      ;

 +52       IF BQITYP="D"

               SET $PIECE(@BQIGREF@(DFN,APCMIC,APCMI),"^",3)=$GET(BQIVAL)

 +53      ;

 +54      ;  Set the Indicator TITLE (.03)

 +55       SET $PIECE(@BQIGREF@(DFN,APCMIC),U,1)=$PIECE(^APCM24OB(APCMIC,0),U,3)

 +56       SET $PIECE(@BQIGREF@(DFN,APCMIC),U,2)=$GET(APCMVALU)

 +57       IF BQITWEN'=""

               SET $PIECE(@BQIGREF@(DFN,APCMIC),U,3)=BQITWEN

 +58       IF BQICURR'=""

               SET $PIECE(@BQIGREF@(DFN,APCMIC),U,4)=BQICURR

 +59       QUIT 

HADV(P,R,BD,ED,VSTS,SC) ;EP - had visit of A, O, R, S with provider R in time frame BD-ED

 +1       ;PATCH 1 excludes ER and case management clinics

 +2       ;patch 1 provider must be primary only

 +3       ; so, in summary, the patient must have at least 1 A,O,R,M, non-ER, non-case man visit

 +4       ; where this provider is the primary provider

 +5        IF '$GET(P)

               QUIT ""

 +6        IF '$GET(R)

               QUIT ""

 +7        IF '$GET(BD)

               QUIT ""

 +8        IF '$GET(ED)

               QUIT ""

 +9        IF '$DATA(^AUPNPAT(P,0))

               QUIT ""

 +10       IF '$DATA(^VA(200,R,0))

               QUIT ""

 +11       NEW V,X,Y,G,S

 +12       SET G=""

 +13       SET X=0

           FOR 

               SET X=$ORDER(VSTS(X))

               IF X'=+X!(G)

                   QUIT 

               Begin DoDot:1

 +14               SET V=$PIECE(VSTS(X),U,5)

 +15               IF '$DATA(^AUPNVSIT(V,0))

                       QUIT 

 +16      ;deleted

                   IF $PIECE(^AUPNVSIT(V,0),U,11)

                       QUIT 

 +17      ;I "AOSM"'[$P(^AUPNVSIT(V,0),U,7) Q  ;not correct service category

 +18               SET S=$PIECE(^AUPNVSIT(V,0),U,7)

 +19      ;no service category

                   IF S=""

                       QUIT 

 +20               IF '$DATA(SC(S))

                       QUIT 

 +21               SET C=$$CLINIC^APCLV(V,"C")

 +22      ;no ER per Carmen patch 1

                   IF C=30

                       QUIT 

 +23      ;no case management clinic 77 per Chris

                   IF C=77

                       QUIT 

 +24      ;no lab

                   IF C=76

                       QUIT 

 +25      ;no radiology

                   IF C=63

                       QUIT 

 +26      ;no pharmacy

                   IF C=39

                       QUIT 

 +27               SET Y=$$PRIMPROV^APCLV(V,"I")

 +28               IF 'Y

                       QUIT 

 +29      ;not this provider

                   IF Y'=R

                       QUIT 

 +30      ;S Y=0 F  S Y=$O(^AUPNVPRV("AD",V,Y)) Q:Y'=+Y!(G)  D

 +31      ;.I $P($G(^AUPNVPRV(Y,0)),U)'=R Q

 +32               SET G=$$VD^APCLV(V)

               End DoDot:1

 +33      ;quit on the date of the visit

           QUIT G

 +34      ;

HADVH(P,R,BD,ED,VSTS,APCMMETH) ;EP - had visit H or ER A,O,S,M

 +1        IF '$GET(P)

               QUIT ""

 +2        IF '$GET(R)

               QUIT ""

 +3        IF '$GET(BD)

               QUIT ""

 +4        IF '$GET(ED)

               QUIT ""

 +5        IF '$DATA(^AUPNPAT(P,0))

               QUIT ""

 +6        IF '$DATA(^DIC(4,R,0))

               QUIT ""

 +7        NEW V,X,Y,G,C

 +8        SET G=""

 +9        SET X=0

           FOR 

               SET X=$ORDER(VSTS(X))

               IF X'=+X!(G)

                   QUIT 

               Begin DoDot:1

 +10               SET V=$PIECE(VSTS(X),U,5)

 +11               IF '$DATA(^AUPNVSIT(V,0))

                       QUIT 

 +12      ;deleted

                   IF $PIECE(^AUPNVSIT(V,0),U,11)

                       QUIT 

 +13      ;not correct facility

                   IF $PIECE(^AUPNVSIT(V,0),U,6)'=R

                       QUIT 

 +14               IF $PIECE(^AUPNVSIT(V,0),U,7)="H"

                       SET G=$$VD^APCLV(V)

                       QUIT 

 +15               IF APCMMETH="O"

                       IF $PIECE(^AUPNVSIT(V,0),U,7)="O"

                           SET G=$$VD^APCLV(V)

                           QUIT 

 +16               IF APCMMETH="O"

                       QUIT 

 +17      ;not correct service category

                   IF $PIECE(^AUPNVSIT(V,0),U,7)'="A"

                       QUIT 

 +18               SET C=$$CLINIC^APCLV(V,"C")

 +19               IF C'=30

                       QUIT 

 +20               SET G=$$VD^APCLV(V)

               End DoDot:1

 +21      ;quit on the date of the visit

           QUIT G

VDOD(P,R,BD,ED,VSTS) ;EP - had visit H or ER A,O,S,M

 +1        IF '$GET(P)

               QUIT ""

 +2        IF '$GET(R)

               QUIT ""

 +3        IF '$GET(BD)

               QUIT ""

 +4        IF '$GET(ED)

               QUIT ""

 +5        IF '$DATA(^AUPNPAT(P,0))

               QUIT ""

 +6        IF '$DATA(^DIC(4,R,0))

               QUIT ""

 +7        NEW V,X,Y,G,C,H,D

 +8        SET G=""

 +9        SET X=0

           FOR 

               SET X=$ORDER(^AUPNVINP("AC",P,X))

               IF X'=+X!(G)

                   QUIT 

               Begin DoDot:1

 +10               SET V=$PIECE($GET(^AUPNVINP(X,0)),U,3)

 +11               IF 'V

                       QUIT 

 +12               IF '$DATA(^AUPNVSIT(V,0))

                       QUIT 

 +13      ;deleted

                   IF $PIECE(^AUPNVSIT(V,0),U,11)

                       QUIT 

 +14      ;not correct facility

                   IF $PIECE(^AUPNVSIT(V,0),U,6)'=R

                       QUIT 

 +15               IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"

                       QUIT 

 +16      ;get discharge type

 +17               SET D=$$VAL^XBDIQ1(9000010.02,X,.06)

 +18               IF D["DEATH"

                       SET G=X

 +19      ;I $$VAL^XBDIQ1(9000010.02,H,6102)="EXPIRED"

               End DoDot:1

 +20      ;quit on the IEN OF THE V HOSP

           QUIT G