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 Dec 13, 2024@02:55:27 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
