DG1010P4.m

DG1010P4 ;ALB/REW - PRINT 1010 CONT'D PART V ; 15 MAR 92

 ;;5.3;Registration;;Aug 13, 1993

RENAME ;DG1010P4 WAS RENAMED TO DG1010S1

 ;

PARTIV K DGBLANK1,DGBLANK2,DGPCDIFF,DGSPC

 ;DGP SET IN DG1010P3

 W !!,?50,"PART IV - MILITARY SERVICE DATA",!,$C(13),DGLUND

 W !,"1A. LAST BRANCH OF SERVICE",?28,"| ","1B. LAST SERVICE NUMBER",?55,"| ","1C. LAST DATE OF ENTRY",?81,"| ","1D. LAST DISCHARGE DATE",?108,"| ","1E. DISCHARGE TYPE"

 W !?4,$$POINT^DG1010P0(DGP(.32),5,23),?28,"| "

 W ?34,$$DISP^DG1010P0(DGP(.32),8),?55,"| ",?61,$$DATE($P(DGP(.32),U,6)),?81,"| ",?87,$$DATE($P(DGP(.32),U,7)),?108,"| ",?114,$E($$POINT^DG1010P0(DGP(.32),4,25),1,17),?131,$C(13),DGLUND

 S DGNA=$S(($P(DGP(.32),U,19)="N"):1,1:0)

 W !,"2A. PRIOR BRANCH OF SERVICE",?28,"| ","2B. PRIOR SERVICE NUMBER",?55,"| ","2C. PRIOR DATE OF ENTRY",?81,"| ","2D. PRIOR DISCHARGE DATE",?108,"| ","2E. DISCHARGE TYPE",!?4

 W:DGNA "NOT APPLICABLE",?28,"| ",?55,"| ",?81,"| ",?108,"| "

 W:('DGNA) $$UNK^DG1010P0($P($G(^DIC(23,+($P(DGP(.32),U,10)),0)),U,1)),?28,"| "

 W:('DGNA) ?34,$$DISP^DG1010P0(DGP(.32),13),?55,"| ",?61,$$DATE($P(DGP(.32),U,11)),?81,"| ",?87,$$DATE($P(DGP(.32),U,12)),?108,"| ",?114,$E($$UNK^DG1010P0($P($G(^DIC(25,+$P(DGP(.32),U,9),0)),U,1)),1,18)

 W ?131,$C(13),DGLUND

 S DGNA=$S((DGNA=0):0,($P(DGP(.32),U,20)="N"):1,1:0)

 W !,"3A. PRIOR BRANCH OF SERVICE",?28,"| ","3B. PRIOR SERVICE NUMBER",?55,"| ","3C. PRIOR DATE OF ENTRY",?81,"| ","3D. PRIOR DISCHARGE DATE",?108,"| ","3E. DISCHARGE TYPE"

 W:('DGNA) !?4,$$UNK^DG1010P0($P($G(^DIC(23,+$P(DGP(.32),U,15),0)),U,1)),?28,"| "

 W:('DGNA) ?34,$$DISP^DG1010P0(DGP(.32),18),?55,"| ",?61,$$DATE($P(DGP(.32),U,16)),?81,"| ",?87,$$DATE($P(DGP(.32),U,17)),?108,"| ",?114,$E($$UNK^DG1010P0($P($G(^DIC(25,+$P(DGP(.32),U,14),0)),U,1)),1,18)

 W:DGNA !?4,"NOT APPLICABLE",?28,"| ",?55,"| ",?81,"| ",?108,"| "

 ;

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

PT5SET F I="TYPE",.3,.31,.312,.32,.36,.361,.362,.372,.373,.38 S DGP(I)=$G(^DPT(DFN,I))

 F I=0,2 S DGP("DIS"_I)=$G(^DPT(DFN,"DIS",DFN1,I))

 G PARTV^DG1010P5

DATE(Y,BL) ;

 ; Returns the external date value

 ;INPUT:  Y  - Date [Internal]

 ;        BL - If Y is null, BL=1 returns null. If BL'=1 'UNANSWERED'

 ;  [Y is REQUIRED]

 ;OUTPUT: Y [RETURNED] -- Date [External]

 I (Y']"")&('+$G(DGBLANK)) S Y="UNANSWERED" G QDT

 X ^DD("DD")

QDT ;

 Q Y

DG1010P4  ;ALB/REW - PRINT 1010 CONT'D PART V ; 15 MAR 92

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

RENAME    ;DG1010P4 WAS RENAMED TO DG1010S1

 +1       ;

PARTIV     KILL DGBLANK1,DGBLANK2,DGPCDIFF,DGSPC

 +1       ;DGP SET IN DG1010P3

 +2        WRITE !!,?50,"PART IV - MILITARY SERVICE DATA",!,$CHAR(13),DGLUND

 +3        WRITE !,"1A. LAST BRANCH OF SERVICE",?28,"| ","1B. LAST SERVICE NUMBER",?55,"| ","1C. LAST DATE OF ENTRY",?81,"| ","1D. LAST DISCHARGE DATE",?108,"| ","1E. DISCHARGE TYPE"

 +4        WRITE !?4,$$POINT^DG1010P0(DGP(.32),5,23),?28,"| "

 +5        WRITE ?34,$$DISP^DG1010P0(DGP(.32),8),?55,"| ",?61,$$DATE($PIECE(DGP(.32),U,6)),?81,"| ",?87,$$DATE($PIECE(DGP(.32),U,7)),?108,"| ",?114,$EXTRACT($$POINT^DG1010P0(DGP(.32),4,25),1,17),?131,$CHAR(13),DGLUND

 +6        SET DGNA=$SELECT(($PIECE(DGP(.32),U,19)="N"):1,1:0)

 +7        WRITE !,"2A. PRIOR BRANCH OF SERVICE",?28,"| ","2B. PRIOR SERVICE NUMBER",?55,"| ","2C. PRIOR DATE OF ENTRY",?81,"| ","2D. PRIOR DISCHARGE DATE",?108,"| ","2E. DISCHARGE TYPE",!?4

 +8        IF DGNA

               WRITE "NOT APPLICABLE",?28,"| ",?55,"| ",?81,"| ",?108,"| "

 +9        IF ('DGNA)

               WRITE $$UNK^DG1010P0($PIECE($GET(^DIC(23,+($PIECE(DGP(.32),U,10)),0)),U,1)),?28,"| "

 +10       IF ('DGNA)

               WRITE ?34,$$DISP^DG1010P0(DGP(.32),13),?55,"| ",?61,$$DATE($PIECE(DGP(.32),U,11)),?81,"| ",?87,$$DATE($PIECE(DGP(.32),U,12)),?108,"| ",?114,$EXTRACT($$UNK^DG1010P0($PIECE($GET(^DIC(25,+$PIECE(DGP(.32),U,9),0)),U,1)),1,18)

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

 +12       SET DGNA=$SELECT((DGNA=0):0,($PIECE(DGP(.32),U,20)="N"):1,1:0)

 +13       WRITE !,"3A. PRIOR BRANCH OF SERVICE",?28,"| ","3B. PRIOR SERVICE NUMBER",?55,"| ","3C. PRIOR DATE OF ENTRY",?81,"| ","3D. PRIOR DISCHARGE DATE",?108,"| ","3E. DISCHARGE TYPE"

 +14       IF ('DGNA)

               WRITE !?4,$$UNK^DG1010P0($PIECE($GET(^DIC(23,+$PIECE(DGP(.32),U,15),0)),U,1)),?28,"| "

 +15       IF ('DGNA)

               WRITE ?34,$$DISP^DG1010P0(DGP(.32),18),?55,"| ",?61,$$DATE($PIECE(DGP(.32),U,16)),?81,"| ",?87,$$DATE($PIECE(DGP(.32),U,17)),?108,"| ",?114,$EXTRACT($$UNK^DG1010P0($PIECE($GET(^DIC(25,+$PIECE(DGP(.32),U,14),0)),U,1)),1,18)

 +16       IF DGNA

               WRITE !?4,"NOT APPLICABLE",?28,"| ",?55,"| ",?81,"| ",?108,"| "

 +17      ;

 +18       WRITE ?131,$CHAR(13),DGLUND,!

PT5SET     FOR I="TYPE",.3,.31,.312,.32,.36,.361,.362,.372,.373,.38

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

 +1        FOR I=0,2

               SET DGP("DIS"_I)=$GET(^DPT(DFN,"DIS",DFN1,I))

 +2        GOTO PARTV^DG1010P5

DATE(Y,BL) ;

 +1       ; Returns the external date value

 +2       ;INPUT:  Y  - Date [Internal]

 +3       ;        BL - If Y is null, BL=1 returns null. If BL'=1 'UNANSWERED'

 +4       ;  [Y is REQUIRED]

 +5       ;OUTPUT: Y [RETURNED] -- Date [External]

 +6        IF (Y']"")&('+$GET(DGBLANK))

               SET Y="UNANSWERED"

               GOTO QDT

 +7        XECUTE ^DD("DD")

QDT       ;

 +1        QUIT Y