DGRP10.m

DGRP10 ;ALB/MRL - REGISTRATION SCREEN 10/MISSING-INELIGIBLE INFORMATION ;06 JUN 88@2300

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 S DGRPS=10 D H^DGRPU F I=.15,.3,"INE" S DGRP(I)=$S($D(^DPT(DFN,I)):^(I),1:"")

 S (DGRPW,Z)=1 D WW^DGRPV S DGRPIN=$P(DGRP(.15),"^",2) W "  Ineligible Date: " S Y=DGRPIN X:Y ^DD("DD") S Z=$S(Y]"":Y,1:DGRPNA),Z1=25 D WW1^DGRPV

 S DGRPX=DGRP("INE"),X=$P(DGRPX,"^",1),X1=DGRPIN,X2=3,X3=4 D TWX

 W !?14,"Reason: ",$S('DGRPIN:DGRPNA,$P(DGRP(.3),"^",7)]"":$P(DGRP(.3),"^",7),1:DGRPU),!?7,"VARO Decision: ",$S('DGRPIN:DGRPNA,$P(DGRPX,"^",6)]"":$E($P(DGRPX,"^",6),1,60),1:DGRPU)

 S Z=2 D WW^DGRPV S DGRPMS=$P(DGRP(.15),"^",3) W "     Missing Date: " S (DGRPIN,Y)=DGRPMS X:Y ^DD("DD") S Z=$S(Y]"":Y,1:DGRPNA),Z1=25 D WW1^DGRPV

 S DGRPX=DGRP("INE"),X=$P(DGRPX,"^",7),X1=DGRPMS,X2=8,X3=9 D TWX

 W !?14,"Reason: " I '$O(^DPT(DFN,.16,0))!'DGRPIN W $S('DGRPIN:DGRPNA,1:"UNSPECIFIED") G Q

 K ^UTILITY($J,"W") S DGFL=0,DIWL=23,DIWF="WC50" F DGRP1=0:0 S DGRP1=$O(^DPT(DFN,.16,DGRP1)) Q:'DGRP1  S DGFL=1,X=^(DGRP1,0) K ^UTILITY($J,1) D ^DIWP

 D ^DIWW

Q K DGRP1,DGRPIN,DGRPMS,DIWF,DIWL

 G ^DGRPP

TWX W "TWX Source: ",$S('X1:DGRPNA,X=1:"VAMC",X=2:"REGIONAL OFFICE",X=3:"RPC",X=4:"OTHER",1:DGRPU)

 W !?12,"TWX City: " S Z=$S('DGRPIN:DGRPNA,$P(DGRPX,"^",X2)]"":$E($P(DGRPX,"^",X2),1,20),1:DGRPU),Z1=26 D WW1^DGRPV W "TWX State: ",$S('DGRPIN:DGRPNA,$D(^DIC(5,+$P(DGRPX,"^",X3),0)):$P(^(0),"^",1),1:DGRPU) Q

DGRP10    ;ALB/MRL - REGISTRATION SCREEN 10/MISSING-INELIGIBLE INFORMATION ;06 JUN 88@2300

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +2        SET DGRPS=10

           DO H^DGRPU

           FOR I=.15,.3,"INE"

               SET DGRP(I)=$SELECT($DATA(^DPT(DFN,I)):^(I),1:"")

 +3        SET (DGRPW,Z)=1

           DO WW^DGRPV

           SET DGRPIN=$PIECE(DGRP(.15),"^",2)

           WRITE "  Ineligible Date: "

           SET Y=DGRPIN

           IF Y

               XECUTE ^DD("DD")

           SET Z=$SELECT(Y]"":Y,1:DGRPNA)

           SET Z1=25

           DO WW1^DGRPV

 +4        SET DGRPX=DGRP("INE")

           SET X=$PIECE(DGRPX,"^",1)

           SET X1=DGRPIN

           SET X2=3

           SET X3=4

           DO TWX

 +5        WRITE !?14,"Reason: ",$SELECT('DGRPIN:DGRPNA,$PIECE(DGRP(.3),"^",7)]"":$PIECE(DGRP(.3),"^",7),1:DGRPU),!?7,"VARO Decision: ",$SELECT('DGRPIN:DGRPNA,$PIECE(DGRPX,"^",6)]"":$EXTRACT($PIECE(DGRPX,"^",6),1,60),1:DGRPU)

 +6        SET Z=2

           DO WW^DGRPV

           SET DGRPMS=$PIECE(DGRP(.15),"^",3)

           WRITE "     Missing Date: "

           SET (DGRPIN,Y)=DGRPMS

           IF Y

               XECUTE ^DD("DD")

           SET Z=$SELECT(Y]"":Y,1:DGRPNA)

           SET Z1=25

           DO WW1^DGRPV

 +7        SET DGRPX=DGRP("INE")

           SET X=$PIECE(DGRPX,"^",7)

           SET X1=DGRPMS

           SET X2=8

           SET X3=9

           DO TWX

 +8        WRITE !?14,"Reason: "

           IF '$ORDER(^DPT(DFN,.16,0))!'DGRPIN

               WRITE $SELECT('DGRPIN:DGRPNA,1:"UNSPECIFIED")

               GOTO Q

 +9        KILL ^UTILITY($JOB,"W")

           SET DGFL=0

           SET DIWL=23

           SET DIWF="WC50"

           FOR DGRP1=0:0

               SET DGRP1=$ORDER(^DPT(DFN,.16,DGRP1))

               IF 'DGRP1

                   QUIT 

               SET DGFL=1

               SET X=^(DGRP1,0)

               KILL ^UTILITY($JOB,1)

               DO ^DIWP

 +10       DO ^DIWW

Q          KILL DGRP1,DGRPIN,DGRPMS,DIWF,DIWL

 +1        GOTO ^DGRPP

TWX        WRITE "TWX Source: ",$SELECT('X1:DGRPNA,X=1:"VAMC",X=2:"REGIONAL OFFICE",X=3:"RPC",X=4:"OTHER",1:DGRPU)

 +1        WRITE !?12,"TWX City: "

           SET Z=$SELECT('DGRPIN:DGRPNA,$PIECE(DGRPX,"^",X2)]"":$EXTRACT($PIECE(DGRPX,"^",X2),1,20),1:DGRPU)

           SET Z1=26

           DO WW1^DGRPV

           WRITE "TWX State: ",$SELECT('DGRPIN:DGRPNA,$DATA(^DIC(5,+$PIECE(DGRPX,"^",X3),0)):$PIECE(^(0),"^",1),1:DGRPU)

           QUIT