Routine: DG1010P2

DG1010P2 ;ALB/REW - PRINT 1010 CONT'D PART II ;2/29/92

 ;;5.3;Registration;;Aug 13, 1993

;;1

CONT ;    CONTINUES FROM DG1010P1

 K DGP,%DT,DGA,DGD2,DGNOCITY,DGX,DGTMP

 F I=.21,.211,.22,.33,.331,.34 S DGP(I)=$G(^DPT(DFN,I))

PARTII W !?50,"PART II - EMERGENCY CONTACT DATA",!,$C(13),DGLUND

GETCON ;

 K DGD

 S DGQ=1

 S DGQ(1)="1A.  FIRST NEXT OF KIN"

 S DGQ(2)="2A.  SECOND NEXT OF KIN"

 S DGQ(3)="3A.  FIRST CONTACT IN AN EMERGENCY"

 S DGQ(4)="4A.  SECOND CONTACT IN AN EMERGENCY"

 S DGQ(5)="5A.  DESIGNEE"

 FOR DGI=.21,.211,.33,.331,.34 D  S DGQ=DGQ+1

 .N DGZ4PC

 .S DGZ4PC=$P("7^3^1^4^2",U,DGQ)

 .FOR DGDPC=1,2,9,11 S:(DGDPC=1) DGBLANK=0 S DGD(DGI,DGDPC)=$$UNK^DG1010P0($P(DGP(DGI),U,DGDPC),0,DGBLANK) S:(DGDPC=1) DGBLANK=+DGUNK

 .S (DGADDR,DGDSTR)=""

 .FOR DGDPC=3,4,5 S DGD1=$P(DGP(DGI),U,DGDPC) I $L(DGD1) S DGDSTR=DGDSTR_$S(DGDPC=3:"",1:",")_DGD1

 .FOR DGDPC=6,7,8 S DGD(DGI,DGDPC)=$P(DGP(DGI),U,DGDPC)

 .S DGDSTR=$$UNK^DG1010P0(DGDSTR,0,DGBLANK)

 .S DGDCTY=$$UNK^DG1010P0(DGD(DGI,6),0,1)_$S((DGUNK=0):", ",1:"")

 .S DGDST=$$UNK^DG1010P0($P($G(^DIC(5,+DGD(DGI,7),0)),U,1),0,1)_$S((DGUNK=0):", ",1:"")

 .S DGDZIP=$$DISP^DG1010P0(DGP(.22),DGZ4PC,0,1)

 .S:DGDZIP&($L(DGDZIP>5)) DGDZIP=$E(DGDZIP,1,5)_"-"_$E(DGDZIP,6,9)

 .S DGDSL=DGDCTY_DGDST_DGDZIP

 .S DGDSUM=$L(DGDSTR)+$L(DGDSL)

 .W !,DGQ(DGQ),?35,"| ",DGQ,"B.  RELATIONSHIP",?66,"| ",DGQ,"C.  HOME TELEPHONE NUMBER",?99,"| ",DGQ,"D.  WORK TELEPHONE NUMBER"

 .W !?5,$E(DGD(DGI,1),1,30),?35,"| ",?42,$E(DGD(DGI,2),1,24),?66,"| ",?73,DGD(DGI,9),?99,"| ",?106,DGD(DGI,11)

 .W ?131,$C(13),DGLUND,!,DGQ,"E.  ADDRESS (Number, Street, City, State, ZIP Code)"

 .W !?5,DGDSTR

 .W:(DGDSUM<128) $S((DGDSUM=0):"",($L(DGDSTR)=DGDSUM):"",1:", "_DGDSL)

 .W:(DGDSUM>127) !?5,DGDSL

 .W ?131,$C(13),DGLUND

 .I DGQ=4 F I=1:1:2 W !,$P($T(DESTXT+I),";;",2)

 .I DGQ=4 W ?131,$C(13),DGLUND

 F I=1:1:5 W !,$P($T(NOTETXT+I),";;",2)

 D FOOTER

 G:$G(DGSTOP) CLEANUP^DG1010P7

 D HEADER

 G PARTIII^DG1010P3

FOOTER ;

 ;RETURNS DGSTOP=1 IF STOP CALLED FOR

 S DGPAGE=DGPAGE+1

 W !,DGLDOUBL,!,"Reg Date/Time:  ",DGAP,?52,"PRINTED: ",DGNOW,?(124-$L(DGCLK)),"Clerk: ",DGCLK

 F I=$Y:1:$S($D(IOSL):(IOSL-5),1:61) W !

 W !,"AUTOMATED VA FORM 10-10",?124,"PAGE: ",DGPAGE

 S DGSTOP=$$SUBSEQ^DGUTL

 I DGSTOP D STOPPED^DGUTL

HEADER ;

 W !,DGNAM,?115,$J(DGSS,13),!,DGLDOUBL

DESTXT ;

 ;;  I DESIGNATE THE FOLLOWING PERSON TO RECEIVE POSSESSION OF ALL PERSONAL PROPERTY LEFT ON THE PREMISES UNDER

 ;;  VA CONTROL AFTER I LEAVE SUCH PLACE OR AT TIME OF MY DEATH (This does not constitute a will or transfer of title.)

;;

NOTETXT ;

 ;;NOTE - The law (38 USC 8520 et seq.) provides that upon the death of any veteran receiving care or treatment by the Department of

 ;;Veterans Affairs in any institution or of a dependent or survivor of a veteran admitted to a VA medical facility leaving no

 ;;surviving spouse or next of kin or heir entitled to inherit, all personal property, including money or balances in bank, all

 ;;claims and choses in action, owned by such person, and not disposed of by will or otherwise will become the property of the

 ;;United States as trustee for the general Post Fund.

DG1010P2  ;ALB/REW - PRINT 1010 CONT'D PART II ;2/29/92

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;;1

CONT      ;    CONTINUES FROM DG1010P1

 +1        KILL DGP,%DT,DGA,DGD2,DGNOCITY,DGX,DGTMP

 +2        FOR I=.21,.211,.22,.33,.331,.34

               SET DGP(I)=$GET(^DPT(DFN,I))

PARTII     WRITE !?50,"PART II - EMERGENCY CONTACT DATA",!,$CHAR(13),DGLUND

GETCON    ;

 +1        KILL DGD

 +2        SET DGQ=1

 +3        SET DGQ(1)="1A.  FIRST NEXT OF KIN"

 +4        SET DGQ(2)="2A.  SECOND NEXT OF KIN"

 +5        SET DGQ(3)="3A.  FIRST CONTACT IN AN EMERGENCY"

 +6        SET DGQ(4)="4A.  SECOND CONTACT IN AN EMERGENCY"

 +7        SET DGQ(5)="5A.  DESIGNEE"

 +8        FOR DGI=.21,.211,.33,.331,.34

               Begin DoDot:1

 +9                NEW DGZ4PC

 +10               SET DGZ4PC=$PIECE("7^3^1^4^2",U,DGQ)

 +11               FOR DGDPC=1,2,9,11

                       IF (DGDPC=1)

                           SET DGBLANK=0

                       SET DGD(DGI,DGDPC)=$$UNK^DG1010P0($PIECE(DGP(DGI),U,DGDPC),0,DGBLANK)

                       IF (DGDPC=1)

                           SET DGBLANK=+DGUNK

 +12               SET (DGADDR,DGDSTR)=""

 +13               FOR DGDPC=3,4,5

                       SET DGD1=$PIECE(DGP(DGI),U,DGDPC)

                       IF $LENGTH(DGD1)

                           SET DGDSTR=DGDSTR_$SELECT(DGDPC=3:"",1:",")_DGD1

 +14               FOR DGDPC=6,7,8

                       SET DGD(DGI,DGDPC)=$PIECE(DGP(DGI),U,DGDPC)

 +15               SET DGDSTR=$$UNK^DG1010P0(DGDSTR,0,DGBLANK)

 +16               SET DGDCTY=$$UNK^DG1010P0(DGD(DGI,6),0,1)_$SELECT((DGUNK=0):", ",1:"")

 +17               SET DGDST=$$UNK^DG1010P0($PIECE($GET(^DIC(5,+DGD(DGI,7),0)),U,1),0,1)_$SELECT((DGUNK=0):", ",1:"")

 +18               SET DGDZIP=$$DISP^DG1010P0(DGP(.22),DGZ4PC,0,1)

 +19               IF DGDZIP&($LENGTH(DGDZIP>5))

                       SET DGDZIP=$EXTRACT(DGDZIP,1,5)_"-"_$EXTRACT(DGDZIP,6,9)

 +20               SET DGDSL=DGDCTY_DGDST_DGDZIP

 +21               SET DGDSUM=$LENGTH(DGDSTR)+$LENGTH(DGDSL)

 +22               WRITE !,DGQ(DGQ),?35,"| ",DGQ,"B.  RELATIONSHIP",?66,"| ",DGQ,"C.  HOME TELEPHONE NUMBER",?99,"| ",DGQ,"D.  WORK TELEPHONE NUMBER"

 +23               WRITE !?5,$EXTRACT(DGD(DGI,1),1,30),?35,"| ",?42,$EXTRACT(DGD(DGI,2),1,24),?66,"| ",?73,DGD(DGI,9),?99,"| ",?106,DGD(DGI,11)

 +24               WRITE ?131,$CHAR(13),DGLUND,!,DGQ,"E.  ADDRESS (Number, Street, City, State, ZIP Code)"

 +25               WRITE !?5,DGDSTR

 +26               IF (DGDSUM<128)

                       WRITE $SELECT((DGDSUM=0):"",($LENGTH(DGDSTR)=DGDSUM):"",1:", "_DGDSL)

 +27               IF (DGDSUM>127)

                       WRITE !?5,DGDSL

 +28               WRITE ?131,$CHAR(13),DGLUND

 +29               IF DGQ=4

                       FOR I=1:1:2

                           WRITE !,$PIECE($TEXT(DESTXT+I),";;",2)

 +30               IF DGQ=4

                       WRITE ?131,$CHAR(13),DGLUND

               End DoDot:1

               SET DGQ=DGQ+1

 +31       FOR I=1:1:5

               WRITE !,$PIECE($TEXT(NOTETXT+I),";;",2)

 +32       DO FOOTER

 +33       IF $GET(DGSTOP)

               GOTO CLEANUP^DG1010P7

 +34       DO HEADER

 +35       GOTO PARTIII^DG1010P3

FOOTER    ;

 +1       ;RETURNS DGSTOP=1 IF STOP CALLED FOR

 +2        SET DGPAGE=DGPAGE+1

 +3        WRITE !,DGLDOUBL,!,"Reg Date/Time:  ",DGAP,?52,"PRINTED: ",DGNOW,?(124-$LENGTH(DGCLK)),"Clerk: ",DGCLK

 +4        FOR I=$Y:1:$SELECT($DATA(IOSL):(IOSL-5),1:61)

               WRITE !

 +5        WRITE !,"AUTOMATED VA FORM 10-10",?124,"PAGE: ",DGPAGE

 +6        SET DGSTOP=$$SUBSEQ^DGUTL

 +7        IF DGSTOP

               DO STOPPED^DGUTL

 +8        QUIT

HEADER    ;

 +1        WRITE !,DGNAM,?115,$JUSTIFY(DGSS,13),!,DGLDOUBL

 +2        QUIT

DESTXT    ;

 +1       ;;  I DESIGNATE THE FOLLOWING PERSON TO RECEIVE POSSESSION OF ALL PERSONAL PROPERTY LEFT ON THE PREMISES UNDER

 +2       ;;  VA CONTROL AFTER I LEAVE SUCH PLACE OR AT TIME OF MY DEATH (This does not constitute a will or transfer of title.)

 +3       ;;

NOTETXT   ;

 +1       ;;NOTE - The law (38 USC 8520 et seq.) provides that upon the death of any veteran receiving care or treatment by the Department of

 +2       ;;Veterans Affairs in any institution or of a dependent or survivor of a veteran admitted to a VA medical facility leaving no

 +3       ;;surviving spouse or next of kin or heir entitled to inherit, all personal property, including money or balances in bank, all

 +4       ;;claims and choses in action, owned by such person, and not disposed of by will or otherwise will become the property of the

 +5       ;;United States as trustee for the general Post Fund.

DG1010P2.m