- DGRP10 ;ALB/MRL,ARF - REGISTRATION SCREEN 10/MISSING-INELIGIBLE INFORMATION ;06 JUN 88@2300
- ;;5.3;Registration;**1081**;Aug 13, 1993;Build 4
- 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
- ;DG*5.3*1081 - Remove "TWX City", "TWX State" and "VARO Decision" from INELIGIBLE/MISSING DATA, SCREEN <10>
- ;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)
- W !?14,"Reason: ",$S('DGRPIN:DGRPNA,$P(DGRP(.3),"^",7)]"":$P(DGRP(.3),"^",7),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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRP10 1642 printed Feb 19, 2025@00:21:29 Page 2
- DGRP10 ;ALB/MRL,ARF - REGISTRATION SCREEN 10/MISSING-INELIGIBLE INFORMATION ;06 JUN 88@2300
- +1 ;;5.3;Registration;**1081**;Aug 13, 1993;Build 4
- +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 ;DG*5.3*1081 - Remove "TWX City", "TWX State" and "VARO Decision" from INELIGIBLE/MISSING DATA, SCREEN <10>
- +5 ;S DGRPX=DGRP("INE"),X=$P(DGRPX,"^",1),X1=DGRPIN,X2=3,X3=4 D TWX
- +6 ;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)
- +7 WRITE !?14,"Reason: ",$SELECT('DGRPIN:DGRPNA,$PIECE(DGRP(.3),"^",7)]"":$PIECE(DGRP(.3),"^",7),1:DGRPU),!
- +8 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
- +9 SET DGRPX=DGRP("INE")
- SET X=$PIECE(DGRPX,"^",7)
- SET X1=DGRPMS
- SET X2=8
- SET X3=9
- DO TWX
- +10 WRITE !?14,"Reason: "
- IF '$ORDER(^DPT(DFN,.16,0))!'DGRPIN
- WRITE $SELECT('DGRPIN:DGRPNA,1:"UNSPECIFIED")
- GOTO Q
- +11 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
- +12 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
