- DG1010S2 ;ALB/MRL - SUPPLEMENTAL DATA SHEET FOR 10-10 (CONT) ; 8/25/00 10:16am
- ;;5.3;Registration;**343,342**;Aug 13, 1993
- ;;MAS VERSION 5.1;
- F I=.321,.52,.21,.53 S DGP(I)=$G(^DPT(DFN,I))
- S DGD=DGP(.321) F I=1:1:3 S DGD(I)=$S($P(DGD,U,I)="Y":"YES",$P(DGD,U,I)="N":"NO",1:"UNKNOWN") S:$P(DGD,U,I)'="Y" DGD(I)=DGD(I)_"^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE" I $P(DGD,U,I)="Y" D UP
- S DGD=DGP(.52),I=3 F I1=5,11 S I=I+1,DGD(I)=$S($P(DGD,U,I1)="Y":"YES",$P(DGD,U,I1)="N":"NO",1:"UNKNOWN") S:$P(DGD,U,I1)'="Y" DGD(I)=DGD(I)_"^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE" I $P(DGD,U,I1)="Y" D UP
- N LL
- S DGD=DGP(.53),I=5 F I2=1:1:3 S I=I+1,DGD(I)=$P(DGD,U,I2) D
- . S:I=6 LL=.531
- . S:I=7 LL=.532
- . S:I=8 LL=.533
- . S DGD(I)=$$EXTERNAL^DILFD(2,LL,,DGD(I))
- . Q
- K LL
- S DGD(6)=$S(DGD(6)]"":DGD(6),1:"UNKNOWN")
- W !?5,"9. Vietnam Service: ",$P(DGD(1),U,1),?38,"From: ",$P(DGD(1),U,2),?62,"To : ",$P(DGD(1),U,3)
- W !?9,"Agent Orange: ",$P(DGD(2),U,1),?38,"Reg : ",$P(DGD(2),U,2),?62,"Exam : ",$P(DGD(2),U,3),?90,"Reg #: ",$P(DGD(2),U,4) W:$P(DGD(2),U,1)="YES" ?112,"Loc: ",$P(DGD(2),U,5)
- W !?9,"ION Radiation: ",$P(DGD(3),U,1),?38,"Reg : ",$P(DGD(3),U,2),?62,"Method: ",$P(DGD(3),U,3),!?9,"Prisoner of War: ",$P(DGD(4),U,1),?38,"From: ",$P(DGD(4),U,2),?62,"To : ",$P(DGD(4),U,3),?90,"Where: ",$P(DGD(4),U,4)
- W !?9,"Combat: ",$P(DGD(5),U,1),?38,"From: ",$P(DGD(5),U,2),?62,"To : ",$P(DGD(5),U,3),?90,"Where: ",$P(DGD(5),U,4)
- W !?9,"Purple Heart: ",DGD(6),?38,$S(DGD(6)="YES"&($L(DGD(7))):"Status: ",DGD(6)="NO"&($L(DGD(8))):"Remarks: ",1:""),$S(DGD(6)="YES":DGD(7),DGD(6)="NO":DGD(8),1:""),!?5,DGLSUP1
- K D S DGAD=DGP(.21),DGA1=3,DGD=$S($L($P(DGAD,U,1)):$P(DGAD,U,1),1:"UNKNOWN"),DGD(1)=$S($L($P(DGAD,U,2)):$P(DGAD,U,2),1:"UNKNOWN"),DGD(2)=$S($L($P(DGAD,U,9)):$P(DGAD,U,9),1:"UNKNOWN") D A
- W !?5,"10. Next of Kin, Address and Zip Code:",?90,"| Relationship: ",$E(DGD(1),1,23),!?9,"Name: ",DGD,?90,"|_____________________________________",!?9,DGA(1),?90,"| Phone: ",DGD(2) F I=2:1:DGA W !?9,DGA(I),?90,"|"
- W !?5,DGLDOUBL,!?5,"reg: ",DGAP,?90,"clerk:",$J(DGCLK,32),!
- Q D ENDREP^DGUTL
- K DA,DGA,DGA1,DGAD,DGAP,DGBL,DGCLK,DGD,DGDEN,DES,DGP,DGEL,DGFAC,FREE,I,I1,I2,I3,IN,IN1,J,DGLDOUBL,DGLSUP,DGLSUP1,DGNAM,DGSV,DGSV1,DGSC,DGSS,DGZ,X,X1,X2,X3,Y Q
- UP I I=1 S Y=$P(DGD,U,4) X:+Y ^DD("DD") S $P(DGD(I),U,2)=$S($L(Y):Y,1:"UNKNOWN"),Y=$P(DGD,U,5) X:+Y ^DD("DD") S $P(DGD(I),U,3)=$S($L(Y):Y,1:"UNKNOWN") Q
- I I=2 D Q
- .S Y=$P(DGD,U,7) X:+Y ^DD("DD") S $P(DGD(I),U,2)=$S($L(Y):Y,1:"UNKNOWN")
- .S Y=$P(DGD,U,9) X:+Y ^DD("DD") S $P(DGD(I),U,3)=$S($L(Y):Y,1:"UNKNOWN")
- .S $P(DGD(I),U,4)=$S($L($P(DGD,U,10)):$P(DGD,U,10),1:"UNKNOWN")
- .S Y=$P(DGD,U,13),$P(DGD(I),U,5)=$S(Y="V":"VIETNAM",Y="K":"KOREAN DMZ",1:"UNKNOWN")
- I I=3 S Y=$P(DGD,U,11) X:+Y ^DD("DD") S $P(DGD(I),U,2)=$S($L(Y):Y,1:"UNKNOWN"),$P(DGD(I),U,3)=$S($P(DGD,U,12)="N":"NAGASAKI/HIROSHIMA",$P(DGD,U,12)="T":"NUCLEAR TESTING",$P(DGD,U,12)="B":"NUCLEAR TESTING & NAGASAKI/HIROSHIMA",1:"") Q
- I I=4 S Y=$P(DGD,U,7) X:+Y ^DD("DD") S $P(DGD(I),U,2)=$S($L(Y):Y,1:"UNKNOWN"),Y=$P(DGD,U,8) X:+Y ^DD("DD") S $P(DGD(I),U,3)=$S($L(Y):Y,1:"UNKNOWN"),$P(DGD(I),U,4)=$S($D(^DIC(22,+$P(DGD,U,6),0)):$P(^(0),U,1),1:"UNKNOWN") Q
- I I=5 S Y=$P(DGD,U,13) X:+Y ^DD("DD") S $P(DGD(I),U,2)=$S($L(Y):Y,1:"UNKNOWN"),Y=$P(DGD,U,14) X:+Y ^DD("DD") S $P(DGD(I),U,3)=$S($L(Y):Y,1:"UNKNOWN"),$P(DGD(I),U,4)=$S($D(^DIC(22,+$P(DGD,U,12),0)):$P(^(0),U,1),1:"UNKNOWN")
- Q
- A S DGA=1 F I=DGA1:1:DGA1+2 S J=$P(DGAD,U,I) I $L(J) S:DGA=3 DGA(2)=DGA(2)_", "_J S:DGA<3 DGA(DGA)=J,DGA=DGA+1
- I DGA=1 S DGA(1)="STREET ADDRESS UNKNOWN",DGA=2
- S J=$S($D(^DIC(5,+$P(DGAD,U,DGA1+4),0)):$P(^(0),U,1),1:""),J(1)=$P(DGAD,U,DGA1+3),J(2)=$P(DGAD,U,DGA1+5),DGA(DGA)=$S($L(J(1))&($L(J)):J(1)_", "_J,$L(J(1)):J(1),$L(J):J,1:"CITY STATE UNKNOWN")
- S DGA(DGA)=DGA(DGA)_" "_$P(DGAD,U,DGA1+5) K I,J,DGA1 Q
- DG1010S2 ;ALB/MRL - SUPPLEMENTAL DATA SHEET FOR 10-10 (CONT) ; 8/25/00 10:16am
- +1 ;;5.3;Registration;**343,342**;Aug 13, 1993
- +2 ;;MAS VERSION 5.1;
- +3 FOR I=.321,.52,.21,.53
- SET DGP(I)=$GET(^DPT(DFN,I))
- +4 SET DGD=DGP(.321)
- FOR I=1:1:3
- SET DGD(I)=$SELECT($PIECE(DGD,U,I)="Y":"YES",$PIECE(DGD,U,I)="N":"NO",1:"UNKNOWN")
- IF $PIECE(DGD,U,I)'="Y"
- SET DGD(I)=DGD(I)_"^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE"
- IF $PIECE(DGD,U,I)="Y"
- DO UP
- +5 SET DGD=DGP(.52)
- SET I=3
- FOR I1=5,11
- SET I=I+1
- SET DGD(I)=$SELECT($PIECE(DGD,U,I1)="Y":"YES",$PIECE(DGD,U,I1)="N":"NO",1:"UNKNOWN")
- IF $PIECE(DGD,U,I1)'="Y"
- SET DGD(I)=DGD(I)_"^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE^NOT APPLICABLE"
- IF $PIECE(DGD,U,I1)="Y"
- DO UP
- +6 NEW LL
- +7 SET DGD=DGP(.53)
- SET I=5
- FOR I2=1:1:3
- SET I=I+1
- SET DGD(I)=$PIECE(DGD,U,I2)
- Begin DoDot:1
- +8 IF I=6
- SET LL=.531
- +9 IF I=7
- SET LL=.532
- +10 IF I=8
- SET LL=.533
- +11 SET DGD(I)=$$EXTERNAL^DILFD(2,LL,,DGD(I))
- +12 QUIT
- End DoDot:1
- +13 KILL LL
- +14 SET DGD(6)=$SELECT(DGD(6)]"":DGD(6),1:"UNKNOWN")
- +15 WRITE !?5,"9. Vietnam Service: ",$PIECE(DGD(1),U,1),?38,"From: ",$PIECE(DGD(1),U,2),?62,"To : ",$PIECE(DGD(1),U,3)
- +16 WRITE !?9,"Agent Orange: ",$PIECE(DGD(2),U,1),?38,"Reg : ",$PIECE(DGD(2),U,2),?62,"Exam : ",$PIECE(DGD(2),U,3),?90,"Reg #: ",$PIECE(DGD(2),U,4)
- IF $PIECE(DGD(2),U,1)="YES"
- WRITE ?112,"Loc: ",$PIECE(DGD(2),U,5)
- +17 WRITE !?9,"ION Radiation: ",$PIECE(DGD(3),U,1),?38,"Reg : ",$PIECE(DGD(3),U,2),?62,"Method: ",$PIECE(DGD(3),U,3),!?9,"Prisoner of War: ",$PIECE(DGD(4),U,1),?38,"From: ",$PIECE(DGD(4),U,2),?62,"To : ",...
- ... $PIECE(DGD(4),U,3),?90,"Where: ",$PIECE(DGD(4),U,4)
- +18 WRITE !?9,"Combat: ",$PIECE(DGD(5),U,1),?38,"From: ",$PIECE(DGD(5),U,2),?62,"To : ",$PIECE(DGD(5),U,3),?90,"Where: ",$PIECE(DGD(5),U,4)
- +19 WRITE !?9,"Purple Heart: ",DGD(6),?38,$SELECT(DGD(6)="YES"&($LENGTH(DGD(7))):"Status: ",DGD(6)="NO"&($LENGTH(DGD(8))):"Remarks: ",1:""),$SELECT(DGD(6)="YES":DGD(7),DGD(6)="NO":DGD(8),1:""),!?5,DGLSUP1
- +20 KILL D
- SET DGAD=DGP(.21)
- SET DGA1=3
- SET DGD=$SELECT($LENGTH($PIECE(DGAD,U,1)):$PIECE(DGAD,U,1),1:"UNKNOWN")
- SET DGD(1)=$SELECT($LENGTH($PIECE(DGAD,U,2)):$PIECE(DGAD,U,2),1:"UNKNOWN")
- SET DGD(2)=$SELECT($LENGTH($PIECE(DGAD,U,9)):$PIECE(DGAD,U,9),1:"UNKNOWN")
- DO A
- +21 WRITE !?5,"10. Next of Kin, Address and Zip Code:",?90,"| Relationship: ",$EXTRACT(DGD(1),1,23),!?9,"Name: ",DGD,?90,"|_____________________________________",!?9,DGA(1),?90,"| Phone: ",DGD(2)
- FOR I=2:1:DGA
- WRITE !?9,DGA(I),?90,"|"
- +22 WRITE !?5,DGLDOUBL,!?5,"reg: ",DGAP,?90,"clerk:",$JUSTIFY(DGCLK,32),!
- Q DO ENDREP^DGUTL
- +1 KILL DA,DGA,DGA1,DGAD,DGAP,DGBL,DGCLK,DGD,DGDEN,DES,DGP,DGEL,DGFAC,FREE,I,I1,I2,I3,IN,IN1,J,DGLDOUBL,DGLSUP,DGLSUP1,DGNAM,DGSV,DGSV1,DGSC,DGSS,DGZ,X,X1,X2,X3,Y
- QUIT
- UP IF I=1
- SET Y=$PIECE(DGD,U,4)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,2)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- SET Y=$PIECE(DGD,U,5)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,3)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- QUIT
- +1 IF I=2
- Begin DoDot:1
- +2 SET Y=$PIECE(DGD,U,7)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,2)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- +3 SET Y=$PIECE(DGD,U,9)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,3)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- +4 SET $PIECE(DGD(I),U,4)=$SELECT($LENGTH($PIECE(DGD,U,10)):$PIECE(DGD,U,10),1:"UNKNOWN")
- +5 SET Y=$PIECE(DGD,U,13)
- SET $PIECE(DGD(I),U,5)=$SELECT(Y="V":"VIETNAM",Y="K":"KOREAN DMZ",1:"UNKNOWN")
- End DoDot:1
- QUIT
- +6 IF I=3
- SET Y=$PIECE(DGD,U,11)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,2)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- SET $PIECE(DGD(I),U,3)=$SELECT($PIECE(DGD,U,12)="N":"NAGASAKI/HIROSHIMA",$PIECE(DGD,U,12)="T":"NUCLEAR TESTING",$PIECE(DGD,U,12)="B":"NUCLEAR TESTING & NAGASAKI/HIROSHIMA",1:"")
- QUIT
- +7 IF I=4
- SET Y=$PIECE(DGD,U,7)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,2)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- SET Y=$PIECE(DGD,U,8)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,3)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- SET $PIECE(DGD(I),U,4)=$SELECT($DATA(^DIC(22,+$PIECE(DGD,U,6),0)):$PIECE(^(0),U,1),1:"UNKNOWN")
- QUIT
- +8 IF I=5
- SET Y=$PIECE(DGD,U,13)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,2)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- SET Y=$PIECE(DGD,U,14)
- IF +Y
- XECUTE ^DD("DD")
- SET $PIECE(DGD(I),U,3)=$SELECT($LENGTH(Y):Y,1:"UNKNOWN")
- SET $PIECE(DGD(I),U,4)=$SELECT($DATA(^DIC(22,+$PIECE(DGD,U,12),0)):$PIECE(^(0),U,1),1:"UNKNOWN")
- +9 QUIT
- A SET DGA=1
- FOR I=DGA1:1:DGA1+2
- SET J=$PIECE(DGAD,U,I)
- IF $LENGTH(J)
- IF DGA=3
- SET DGA(2)=DGA(2)_", "_J
- IF DGA<3
- SET DGA(DGA)=J
- SET DGA=DGA+1
- +1 IF DGA=1
- SET DGA(1)="STREET ADDRESS UNKNOWN"
- SET DGA=2
- +2 SET J=$SELECT($DATA(^DIC(5,+$PIECE(DGAD,U,DGA1+4),0)):$PIECE(^(0),U,1),1:"")
- SET J(1)=$PIECE(DGAD,U,DGA1+3)
- SET J(2)=$PIECE(DGAD,U,DGA1+5)
- SET DGA(DGA)=$SELECT($LENGTH(J(1))&($LENGTH(J)):J(1)_", "_J,$LENGTH(J(1)):J(1),$LENGTH(J):J,1:"CITY STATE UNKNOWN")
- +3 SET DGA(DGA)=DGA(DGA)_" "_$PIECE(DGAD,U,DGA1+5)
- KILL I,J,DGA1
- QUIT
