DGRPTP1 ;ALB/RMO - Print 10-10T Registration Cont.;06 JAN 1997 3:15 pm ; 8/18/00 2:48pm
;;5.3;Registration;**108,343**;Aug 13, 1993
;
EN(DFN,DFN1,DGNAM,DGSSN,DGLNE,DGPGE) ;Entry point to print 10-10T cont.
; Input -- DFN Patient IEN
; DFN1 Disposition multiple IEN (optional)
; DGNAM Patient name
; DGSSN Patient ssn
; DGLNE Line format array
; DGPGE Page number
; Output -- None
N X
W ?116,"VA FORM 10-10T",!,DGLNE("DD"),!?35,"D E P A R T M E N T O F V E T E R A N S A F F A I R S",!,DGLNE("DD")
S X=$$SITE^VASITE W !,"FACILITY: ",$S($G(X):$P(X,U,2)_" ("_$P(X,U,3)_")")
W ?96,"APPLICATION FOR MEDICAL BENEFITS",!,DGLNE("DD")
D DEM(DFN,DGNAM,DGSSN,.DGLNE) ;patient demographics
D EMC(DFN,.DGLNE) ;emergency contact
D BEN(DFN,$G(DFN1),.DGLNE) ;benefit applying for
D APS(DFN,.DGLNE) ;applicant status
D EXP(DFN,.DGLNE) ;exposure
D MCR(DFN,$G(DFN1),.DGLNE) ;medical care related to
D EN^DGRPTP2(DFN,$G(DFN1),DGNAM,DGSSN,.DGLNE,DGPGE) ;print cont.
Q
;
DEM(DFN,DGNAM,DGSSN,DGLNE) ;Patient demographics
; Input -- DFN Patient IEN
; DGNAM Patient name
; DGSSN Patient ssn
; DGLNE Line format array
; Output -- None
N C,DGRP,I,Y
;
;Name, ssn, dob
S DGRP(0)=$G(^DPT(DFN,0)) ;patient
W !,"1. Applicant's Name",?60,"|2. Social Security Number",?98,"|3. Date of Birth"
W !?3,DGNAM,?60,"| ",DGSSN,?98,"| ",$$DATENP^DG1010P0(DGRP(0),3)
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
;
;Street Address
W !,"4A. Applicant's Mailing Street Address"
S DGRP(.11)=$G(^DPT(DFN,.11)) ;address
W !?4,$$DISP^DG1010P0(DGRP(.11),1)
F I=2:1:3 W:$P(DGRP(.11),U,I)'="" !?4,$$DISP^DG1010P0(DGRP(.11),I)
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
;
;City, county, zip, state
W !,"4B. City",?33,"|4C. County",?65,"|4D. Zip Code",?95,"|4E. State"
W !?4,$$DISP^DG1010P0(DGRP(.11),4)
W ?33,"| ",$$POINT^DG1010P0(DGRP(.11),7,"^DIC(5,"_+$P(DGRP(.11),U,5)_",1,")
S Y=$P(DGRP(.11),U,12) ;zip code
D:Y'="" ZIPOUT^VAFADDR ;output transform
W ?65,"| ",$S(Y'="":Y,1:"UNANSWERED")
W ?95,"| ",$$POINT^DG1010P0(DGRP(.11),5,5)
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
;
;Sex, phone
W !,"5. Patient's Sex",?33,"|6. Home Telephone Number",?65,"|7. Work Telephone Number"
S Y=$P(DGRP(0),U,2),C=$P(^DD(2,.02,0),U,2) D Y^DIQ
W !,?3,$S(Y'="":Y,1:"UNANSWERED")
S DGRP(.13)=$G(^DPT(DFN,.13)) ;phone
W ?33,"| ",$$DISP^DG1010P0(DGRP(.13),1)
W ?65,"| ",$$DISP^DG1010P0(DGRP(.13),2)
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
;
EMC(DFN,DGLNE) ;Emergency contact
; Input -- DFN Patient IEN
; DGLNE Line format array
; Output -- None
N C,DGA,DGA1,DGA2,DGAD,DGADI,DGEMCF,DGRP,Y
;
;Name, relationship, phone
S DGRP(.33)=$G(^DPT(DFN,.33)) ;emergency contact
S DGEMCF=$S($P(DGRP(.33),U,1)'="":1,1:0)
W !,"8A. Emergency Contact",?40,"|8B. Relationship",?65,"|8C. Home Telephone Number",?95,"|8D. Work Telephone Number"
W !?4,$$DISP^DG1010P0(DGRP(.33),1)
W ?40,"| " W:DGEMCF $$DISP^DG1010P0(DGRP(.33),2)
W ?65,"| " W:DGEMCF $$DISP^DG1010P0(DGRP(.33),9)
W ?95,"| " W:DGEMCF $$DISP^DG1010P0(DGRP(.33),11)
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
;
;Address, Is emergency contact also NOK
W !,"8E. Mailing Address of Emergency Contact",?95,"|9. Is Emergency Contact"
I DGEMCF D
. S DGAD=.33,DGA1=3,DGA2=1 D A^DGRPU
S DGADI=+$O(DGA(0))
W !?4,$S(DGADI:DGA(DGADI),1:"")
W ?95,"|Also Next of Kin"
S DGADI=+$O(DGA(DGADI))
W !?4,$S(DGADI:DGA(DGADI),1:"")
S Y=$P(DGRP(.33),U,10),C=$P(^DD(2,.3305,0),U,2) D Y^DIQ
W ?95,"| ",$S(Y'="":Y,1:"UNANSWERED")
F S DGADI=$O(DGA(DGADI)) Q:DGADI="" D
. W !?4,DGA(DGADI)
. W ?95,"|"
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
;
BEN(DFN,DFN1,DGLNE) ;Benefit applying for
; Input -- DFN Patient IEN
; DFN1 Disposition multiple IEN (optional)
; DGLNE Line format array
; Output -- None
N C,DGDIS,Y
;
W !,"10. Benefit Applying For: "
S DGDIS(0)=$G(^DPT(DFN,"DIS",+$G(DFN1),0))
I $P(DGDIS(0),U,20) D
. S Y=$P(DGDIS(0),U,3),C=$P(^DD(2.101,2,0),U,2) D Y^DIQ
. W $S("^1^3^"[(U_$P(DGDIS(0),U,3)_U):"HOSPITAL/OUTPATIENT TREATMENT",Y'="":Y,1:"UNANSWERED")
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
;
APS(DFN,DGLNE) ;Applicant status
; Input -- DFN Patient IEN
; DGLNE Line format array
; Output -- None
N C,DGADI,DGRP,Y
;
W !,"11. Applicant Status: ",!,DGLNE("D")
;
;Service connected, pow, a&a, mil disab
W !,"A. Service Connected",?33,"|B. Prisoner of War",?65,"|C. Aid and Attendance",?95,"|D. Military Disability Retired"
S DGRP(.3)=$G(^DPT(DFN,.3)) ;service connected
S Y=$P(DGRP(.3),U,1),C=$P(^DD(2,.301,0),U,2) D Y^DIQ
W !?3,$S(Y'="":Y,1:"UNANSWERED")
S DGRP(.52)=$G(^DPT(DFN,.52)) ;pow
S Y=$P(DGRP(.52),U,5),C=$P(^DD(2,.525,0),U,2) D Y^DIQ
W ?33,"| ",$S(Y'="":Y,1:"UNANSWERED")
S DGRP(.362)=$G(^DPT(DFN,.362)) ;a&a, pension
S Y=$P(DGRP(.362),U,12),C=$P(^DD(2,.36205,0),U,2) D Y^DIQ
W ?65,"| ",$S(Y'="":Y,1:"UNANSWERED")
S DGRP(.36)=$G(^DPT(DFN,.36)) ;mil disab
S Y=$P(DGRP(.36),U,2),C=$P(^DD(2,.362,0),U,2) D Y^DIQ
W ?95,"| ",$S(Y'="":Y,1:"UNANSWERED")
W !,DGLNE("D")
;
;VA pension, eligibility, other elig
W !,"E. VA Pension",?33,"|F. Primary Eligibility Code",?65,"|G. Other Eligibility Code",?95,"|H. Purple Heart Recipient"
S Y=$P(DGRP(.362),U,14),C=$P(^DD(2,.36235,0),U,2) D Y^DIQ
W !?3,$S(Y'="":Y,1:"UNANSWERED")
W ?33,"| ",$$ELIG^DG1010P5(+DGRP(.36))
S (C,DGADI)=0 F S DGADI=$O(^DPT(DFN,"E",DGADI)) Q:'DGADI I DGADI'=+DGRP(.36) D
. S C=C+1
. W:C>1 !?33,"|"
. W ?65,"| ",$$ELIG^DG1010P5(DGADI)
W:'C ?65,"|"
S DGRP(.53)=$G(^DPT(DFN,.53)) ;purple heart
S Y=$P(DGRP(.53),U,1),C=$P(^DD(2,.531,0),U,2) D Y^DIQ
W ?95,"| ",$S(Y'="":Y,1:"UNANSWERED")
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
;
EXP(DFN,DGLNE) ;Exposure
; Input -- DFN Patient IEN
; DGLNE Line format array
; Output -- None
N C,DGRP,Y
;
W !,"12. Exposure To: "
;
;Agent orange, radiation, env contam
W ?33,"|A. Agent Orange",?65,"|B. Radiation",?95,"|C. Environmental Contaminants"
S DGRP(.321)=$G(^DPT(DFN,.321)) ;ao/ir exposure
S Y=$P(DGRP(.321),U,2),C=$P(^DD(2,.32102,0),U,2) D Y^DIQ
W !?33,"| ",$S(Y'="":Y,1:"UNANSWERED")
S Y=$P(DGRP(.321),U,3),C=$P(^DD(2,.32103,0),U,2) D Y^DIQ
W ?65,"| ",$S(Y'="":Y,1:"UNANSWERED")
S DGRP(.322)=$G(^DPT(DFN,.322)) ;env contam
S Y=$P(DGRP(.322),U,13),C=$P(^DD(2,.322013,0),U,2) D Y^DIQ
W ?95,"| ",$S(Y'="":Y,1:"UNANSWERED")
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
;
MCR(DFN,DFN1,DGLNE) ;Medical care related to
; Input -- DFN Patient IEN
; DFN1 Disposition multiple IEN (optional)
; DGLNE Line format array
; Output -- None
N C,DGDIS,Y
;
W !,"13. Medical Care Related To: "
;
;Injury, accident
W ?33,"|A. On-The-Job-Injury",?65,"|B. Accident"
S DGDIS(0)=$G(^DPT(DFN,"DIS",+$G(DFN1),0))
I $P(DGDIS(0),U,20) D
. S DGDIS(2)=$G(^DPT(DFN,"DIS",+$G(DFN1),2))
. S Y=$P(DGDIS(2),U,1),C=$P(^DD(2.101,20,0),U,2) D Y^DIQ
. W !?33,"| ",$S(Y'="":Y,1:"UNANSWERED")
. S Y=$P(DGDIS(2),U,4),C=$P(^DD(2.101,23,0),U,2) D Y^DIQ
. W ?65,"| ",$S(Y'="":Y,1:"UNANSWERED")
ELSE D
. W !?33,"|"
. W ?65,"|"
W ?131,$C(13) W:DGLNE("ULC")="-" ! W DGLNE("UL")
Q
DGRPTP1 ;ALB/RMO - Print 10-10T Registration Cont.;06 JAN 1997 3:15 pm ; 8/18/00 2:48pm
+1 ;;5.3;Registration;**108,343**;Aug 13, 1993
+2 ;
EN(DFN,DFN1,DGNAM,DGSSN,DGLNE,DGPGE) ;Entry point to print 10-10T cont.
+1 ; Input -- DFN Patient IEN
+2 ; DFN1 Disposition multiple IEN (optional)
+3 ; DGNAM Patient name
+4 ; DGSSN Patient ssn
+5 ; DGLNE Line format array
+6 ; DGPGE Page number
+7 ; Output -- None
+8 NEW X
+9 WRITE ?116,"VA FORM 10-10T",!,DGLNE("DD"),!?35,"D E P A R T M E N T O F V E T E R A N S A F F A I R S",!,DGLNE("DD")
+10 SET X=$$SITE^VASITE
WRITE !,"FACILITY: ",$SELECT($GET(X):$PIECE(X,U,2)_" ("_$PIECE(X,U,3)_")")
+11 WRITE ?96,"APPLICATION FOR MEDICAL BENEFITS",!,DGLNE("DD")
+12 ;patient demographics
DO DEM(DFN,DGNAM,DGSSN,.DGLNE)
+13 ;emergency contact
DO EMC(DFN,.DGLNE)
+14 ;benefit applying for
DO BEN(DFN,$GET(DFN1),.DGLNE)
+15 ;applicant status
DO APS(DFN,.DGLNE)
+16 ;exposure
DO EXP(DFN,.DGLNE)
+17 ;medical care related to
DO MCR(DFN,$GET(DFN1),.DGLNE)
+18 ;print cont.
DO EN^DGRPTP2(DFN,$GET(DFN1),DGNAM,DGSSN,.DGLNE,DGPGE)
+19 QUIT
+20 ;
DEM(DFN,DGNAM,DGSSN,DGLNE) ;Patient demographics
+1 ; Input -- DFN Patient IEN
+2 ; DGNAM Patient name
+3 ; DGSSN Patient ssn
+4 ; DGLNE Line format array
+5 ; Output -- None
+6 NEW C,DGRP,I,Y
+7 ;
+8 ;Name, ssn, dob
+9 ;patient
SET DGRP(0)=$GET(^DPT(DFN,0))
+10 WRITE !,"1. Applicant's Name",?60,"|2. Social Security Number",?98,"|3. Date of Birth"
+11 WRITE !?3,DGNAM,?60,"| ",DGSSN,?98,"| ",$$DATENP^DG1010P0(DGRP(0),3)
+12 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+13 ;
+14 ;Street Address
+15 WRITE !,"4A. Applicant's Mailing Street Address"
+16 ;address
SET DGRP(.11)=$GET(^DPT(DFN,.11))
+17 WRITE !?4,$$DISP^DG1010P0(DGRP(.11),1)
+18 FOR I=2:1:3
IF $PIECE(DGRP(.11),U,I)'=""
WRITE !?4,$$DISP^DG1010P0(DGRP(.11),I)
+19 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+20 ;
+21 ;City, county, zip, state
+22 WRITE !,"4B. City",?33,"|4C. County",?65,"|4D. Zip Code",?95,"|4E. State"
+23 WRITE !?4,$$DISP^DG1010P0(DGRP(.11),4)
+24 WRITE ?33,"| ",$$POINT^DG1010P0(DGRP(.11),7,"^DIC(5,"_+$PIECE(DGRP(.11),U,5)_",1,")
+25 ;zip code
SET Y=$PIECE(DGRP(.11),U,12)
+26 ;output transform
IF Y'=""
DO ZIPOUT^VAFADDR
+27 WRITE ?65,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+28 WRITE ?95,"| ",$$POINT^DG1010P0(DGRP(.11),5,5)
+29 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+30 ;
+31 ;Sex, phone
+32 WRITE !,"5. Patient's Sex",?33,"|6. Home Telephone Number",?65,"|7. Work Telephone Number"
+33 SET Y=$PIECE(DGRP(0),U,2)
SET C=$PIECE(^DD(2,.02,0),U,2)
DO Y^DIQ
+34 WRITE !,?3,$SELECT(Y'="":Y,1:"UNANSWERED")
+35 ;phone
SET DGRP(.13)=$GET(^DPT(DFN,.13))
+36 WRITE ?33,"| ",$$DISP^DG1010P0(DGRP(.13),1)
+37 WRITE ?65,"| ",$$DISP^DG1010P0(DGRP(.13),2)
+38 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+39 QUIT
+40 ;
EMC(DFN,DGLNE) ;Emergency contact
+1 ; Input -- DFN Patient IEN
+2 ; DGLNE Line format array
+3 ; Output -- None
+4 NEW C,DGA,DGA1,DGA2,DGAD,DGADI,DGEMCF,DGRP,Y
+5 ;
+6 ;Name, relationship, phone
+7 ;emergency contact
SET DGRP(.33)=$GET(^DPT(DFN,.33))
+8 SET DGEMCF=$SELECT($PIECE(DGRP(.33),U,1)'="":1,1:0)
+9 WRITE !,"8A. Emergency Contact",?40,"|8B. Relationship",?65,"|8C. Home Telephone Number",?95,"|8D. Work Telephone Number"
+10 WRITE !?4,$$DISP^DG1010P0(DGRP(.33),1)
+11 WRITE ?40,"| "
IF DGEMCF
WRITE $$DISP^DG1010P0(DGRP(.33),2)
+12 WRITE ?65,"| "
IF DGEMCF
WRITE $$DISP^DG1010P0(DGRP(.33),9)
+13 WRITE ?95,"| "
IF DGEMCF
WRITE $$DISP^DG1010P0(DGRP(.33),11)
+14 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+15 ;
+16 ;Address, Is emergency contact also NOK
+17 WRITE !,"8E. Mailing Address of Emergency Contact",?95,"|9. Is Emergency Contact"
+18 IF DGEMCF
Begin DoDot:1
+19 SET DGAD=.33
SET DGA1=3
SET DGA2=1
DO A^DGRPU
End DoDot:1
+20 SET DGADI=+$ORDER(DGA(0))
+21 WRITE !?4,$SELECT(DGADI:DGA(DGADI),1:"")
+22 WRITE ?95,"|Also Next of Kin"
+23 SET DGADI=+$ORDER(DGA(DGADI))
+24 WRITE !?4,$SELECT(DGADI:DGA(DGADI),1:"")
+25 SET Y=$PIECE(DGRP(.33),U,10)
SET C=$PIECE(^DD(2,.3305,0),U,2)
DO Y^DIQ
+26 WRITE ?95,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+27 FOR
SET DGADI=$ORDER(DGA(DGADI))
IF DGADI=""
QUIT
Begin DoDot:1
+28 WRITE !?4,DGA(DGADI)
+29 WRITE ?95,"|"
End DoDot:1
+30 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+31 QUIT
+32 ;
BEN(DFN,DFN1,DGLNE) ;Benefit applying for
+1 ; Input -- DFN Patient IEN
+2 ; DFN1 Disposition multiple IEN (optional)
+3 ; DGLNE Line format array
+4 ; Output -- None
+5 NEW C,DGDIS,Y
+6 ;
+7 WRITE !,"10. Benefit Applying For: "
+8 SET DGDIS(0)=$GET(^DPT(DFN,"DIS",+$GET(DFN1),0))
+9 IF $PIECE(DGDIS(0),U,20)
Begin DoDot:1
+10 SET Y=$PIECE(DGDIS(0),U,3)
SET C=$PIECE(^DD(2.101,2,0),U,2)
DO Y^DIQ
+11 WRITE $SELECT("^1^3^"[(U_$PIECE(DGDIS(0),U,3)_U):"HOSPITAL/OUTPATIENT TREATMENT",Y'="":Y,1:"UNANSWERED")
End DoDot:1
+12 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+13 QUIT
+14 ;
APS(DFN,DGLNE) ;Applicant status
+1 ; Input -- DFN Patient IEN
+2 ; DGLNE Line format array
+3 ; Output -- None
+4 NEW C,DGADI,DGRP,Y
+5 ;
+6 WRITE !,"11. Applicant Status: ",!,DGLNE("D")
+7 ;
+8 ;Service connected, pow, a&a, mil disab
+9 WRITE !,"A. Service Connected",?33,"|B. Prisoner of War",?65,"|C. Aid and Attendance",?95,"|D. Military Disability Retired"
+10 ;service connected
SET DGRP(.3)=$GET(^DPT(DFN,.3))
+11 SET Y=$PIECE(DGRP(.3),U,1)
SET C=$PIECE(^DD(2,.301,0),U,2)
DO Y^DIQ
+12 WRITE !?3,$SELECT(Y'="":Y,1:"UNANSWERED")
+13 ;pow
SET DGRP(.52)=$GET(^DPT(DFN,.52))
+14 SET Y=$PIECE(DGRP(.52),U,5)
SET C=$PIECE(^DD(2,.525,0),U,2)
DO Y^DIQ
+15 WRITE ?33,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+16 ;a&a, pension
SET DGRP(.362)=$GET(^DPT(DFN,.362))
+17 SET Y=$PIECE(DGRP(.362),U,12)
SET C=$PIECE(^DD(2,.36205,0),U,2)
DO Y^DIQ
+18 WRITE ?65,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+19 ;mil disab
SET DGRP(.36)=$GET(^DPT(DFN,.36))
+20 SET Y=$PIECE(DGRP(.36),U,2)
SET C=$PIECE(^DD(2,.362,0),U,2)
DO Y^DIQ
+21 WRITE ?95,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+22 WRITE !,DGLNE("D")
+23 ;
+24 ;VA pension, eligibility, other elig
+25 WRITE !,"E. VA Pension",?33,"|F. Primary Eligibility Code",?65,"|G. Other Eligibility Code",?95,"|H. Purple Heart Recipient"
+26 SET Y=$PIECE(DGRP(.362),U,14)
SET C=$PIECE(^DD(2,.36235,0),U,2)
DO Y^DIQ
+27 WRITE !?3,$SELECT(Y'="":Y,1:"UNANSWERED")
+28 WRITE ?33,"| ",$$ELIG^DG1010P5(+DGRP(.36))
+29 SET (C,DGADI)=0
FOR
SET DGADI=$ORDER(^DPT(DFN,"E",DGADI))
IF 'DGADI
QUIT
IF DGADI'=+DGRP(.36)
Begin DoDot:1
+30 SET C=C+1
+31 IF C>1
WRITE !?33,"|"
+32 WRITE ?65,"| ",$$ELIG^DG1010P5(DGADI)
End DoDot:1
+33 IF 'C
WRITE ?65,"|"
+34 ;purple heart
SET DGRP(.53)=$GET(^DPT(DFN,.53))
+35 SET Y=$PIECE(DGRP(.53),U,1)
SET C=$PIECE(^DD(2,.531,0),U,2)
DO Y^DIQ
+36 WRITE ?95,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+37 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+38 QUIT
+39 ;
EXP(DFN,DGLNE) ;Exposure
+1 ; Input -- DFN Patient IEN
+2 ; DGLNE Line format array
+3 ; Output -- None
+4 NEW C,DGRP,Y
+5 ;
+6 WRITE !,"12. Exposure To: "
+7 ;
+8 ;Agent orange, radiation, env contam
+9 WRITE ?33,"|A. Agent Orange",?65,"|B. Radiation",?95,"|C. Environmental Contaminants"
+10 ;ao/ir exposure
SET DGRP(.321)=$GET(^DPT(DFN,.321))
+11 SET Y=$PIECE(DGRP(.321),U,2)
SET C=$PIECE(^DD(2,.32102,0),U,2)
DO Y^DIQ
+12 WRITE !?33,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+13 SET Y=$PIECE(DGRP(.321),U,3)
SET C=$PIECE(^DD(2,.32103,0),U,2)
DO Y^DIQ
+14 WRITE ?65,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+15 ;env contam
SET DGRP(.322)=$GET(^DPT(DFN,.322))
+16 SET Y=$PIECE(DGRP(.322),U,13)
SET C=$PIECE(^DD(2,.322013,0),U,2)
DO Y^DIQ
+17 WRITE ?95,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+18 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+19 QUIT
+20 ;
MCR(DFN,DFN1,DGLNE) ;Medical care related to
+1 ; Input -- DFN Patient IEN
+2 ; DFN1 Disposition multiple IEN (optional)
+3 ; DGLNE Line format array
+4 ; Output -- None
+5 NEW C,DGDIS,Y
+6 ;
+7 WRITE !,"13. Medical Care Related To: "
+8 ;
+9 ;Injury, accident
+10 WRITE ?33,"|A. On-The-Job-Injury",?65,"|B. Accident"
+11 SET DGDIS(0)=$GET(^DPT(DFN,"DIS",+$GET(DFN1),0))
+12 IF $PIECE(DGDIS(0),U,20)
Begin DoDot:1
+13 SET DGDIS(2)=$GET(^DPT(DFN,"DIS",+$GET(DFN1),2))
+14 SET Y=$PIECE(DGDIS(2),U,1)
SET C=$PIECE(^DD(2.101,20,0),U,2)
DO Y^DIQ
+15 WRITE !?33,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
+16 SET Y=$PIECE(DGDIS(2),U,4)
SET C=$PIECE(^DD(2.101,23,0),U,2)
DO Y^DIQ
+17 WRITE ?65,"| ",$SELECT(Y'="":Y,1:"UNANSWERED")
End DoDot:1
+18 IF '$TEST
Begin DoDot:1
+19 WRITE !?33,"|"
+20 WRITE ?65,"|"
End DoDot:1
+21 WRITE ?131,$CHAR(13)
IF DGLNE("ULC")="-"
WRITE !
WRITE DGLNE("UL")
+22 QUIT
