DGRPP1 ;ALB/MRL,ASF,LEG - REGISTRATION SCREEN PROCESSOR (CONTINUED) ;3/5/20 12:20
;;5.3;Registration;**489,508,997**;Aug 13, 1993;Build 42
;
STR ;write string of selectable items on the bottom of the screen
;
;DGRPANP = string to print of selectable items (on bottom of screen)
;K = 1 if all items are not selectable (DGRPANP=x,y,z,)
; 0 if whole range is selectable (DGRPANP=x-y)
;K1 = first item
;K2 = last item
;
S (K,K1,K2)="" F I=1:1 S J=+$P(DGRPAN,",",I) Q:'J S K2=+J S:I=1 K1=J I +$P(DGRPAN,",",I+1),+$P(DGRPAN,",",I+1)'=(J+1) S K=1
S DGRPANP=$S(K:$E(DGRPAN,1,$L(DGRPAN)-1),K1=K2:K1,1:K1_"-"_K2)
K K,K1,K2,I,J,I1
Q
;
LT ;local registration template questions
I '$D(^DG(43,1,0)) W !!,*7,"Your MAS PARAMETER file is not properly set up!" Q
S XX=$S($D(^DIE(+$P(^DG(43,1,0),"^",35),0)):$P(^(0),"^",1),1:"") I XX']"" Q
W @IOF S DGRPCM=1,Z="LOCAL REGISTRATION QUESTIONS",X=25 D W^DGRPU
S X1="",$P(X1,"=",81)="" W !,X1,!!
S DR="["_XX_"]",DIE="^DPT(",(DA,Y)=DFN D ^DIE
K XX Q
;
JUMP ;jump screens (^N)
S X=+$E(DGRPANN,2,99) I $D(DGRPVV(X)) S X1=$E(DGRPVV,$P(X,".")) I X1]"",'X1 G @$S(X=1.1:"^DGRPCADD",X=11.5:"^DGRP11A",1:"^DGRP"_X) ;DG*5.3*997; added 11.5 flow
;LEG; DG*5.3*997; modified display as it was too long for the number of screens identified
;S Z="INVALID SCREEN NUMBER...VALID SCREENS ARE " F I=1,1.1,2:1:DGRPLAST I '$E(DGRPVV,I) S Z=Z_$S(I=DGRPLAST:" and ",1:"")_I_$S(I<DGRPLAST:",",1:".")
S Z="INVALID ENTRY...VALID SCREEN #s: " F I=1,1.1,2:1:11,11.5,12:1:DGRPLAST I '$E(DGRPVV,I) S Z=Z_I_$S(I<DGRPLAST:",",1:".")
W !,*7 D W H 2
G:DGRPS=1.1 ^DGRPCADD ;return to same screen
G:DGRPS["11.5" ^DGRP11A ;DG*5.3*997; added 11.5 flow
G:DGRPS'=1.1 @("^DGRP"_DGRPS)
;
WHICH ; if screen 9, which elements can be edited (vet, spouse, dependents)
I DGRPS'=9 S DGRPSEL="" Q
S DGRPSEL="V" I $D(DGREL("S")) S DGRPSEL=DGRPSEL_"S"
I $O(DGREL("D",0)) S DGRPSEL=DGRPSEL_"D"
Q
;
MOREHLP ; print additional help prompt for screen 9
I DGRPVV(9)'["0"!+$G(DGRPV) Q ;view only
W !,"(To edit only veteran income, precede selection with 'V' [ex. 'V1-3']" I DGRPSEL]"V" W $S(DGRPSEL["SD":",",1:" or"),!
I DGRPSEL["S" W "precede with 'S' to edit spouse" I DGRPSEL["D" W ", or "
I DGRPSEL["D" W "precede with 'D' to edit dependents"
W "): "
Q
;
W ;write highlighted text on screen (if parameter on)
I IOST="C-QUME",$L(DGVI)'=2 W Z
E W @DGVI,Z,@DGVO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPP1 2441 printed Apr 09, 2024@21:57:22 Page 2
DGRPP1 ;ALB/MRL,ASF,LEG - REGISTRATION SCREEN PROCESSOR (CONTINUED) ;3/5/20 12:20
+1 ;;5.3;Registration;**489,508,997**;Aug 13, 1993;Build 42
+2 ;
STR ;write string of selectable items on the bottom of the screen
+1 ;
+2 ;DGRPANP = string to print of selectable items (on bottom of screen)
+3 ;K = 1 if all items are not selectable (DGRPANP=x,y,z,)
+4 ; 0 if whole range is selectable (DGRPANP=x-y)
+5 ;K1 = first item
+6 ;K2 = last item
+7 ;
+8 SET (K,K1,K2)=""
FOR I=1:1
SET J=+$PIECE(DGRPAN,",",I)
if 'J
QUIT
SET K2=+J
if I=1
SET K1=J
IF +$PIECE(DGRPAN,",",I+1)
IF +$PIECE(DGRPAN,",",I+1)'=(J+1)
SET K=1
+9 SET DGRPANP=$SELECT(K:$EXTRACT(DGRPAN,1,$LENGTH(DGRPAN)-1),K1=K2:K1,1:K1_"-"_K2)
+10 KILL K,K1,K2,I,J,I1
+11 QUIT
+12 ;
LT ;local registration template questions
+1 IF '$DATA(^DG(43,1,0))
WRITE !!,*7,"Your MAS PARAMETER file is not properly set up!"
QUIT
+2 SET XX=$SELECT($DATA(^DIE(+$PIECE(^DG(43,1,0),"^",35),0)):$PIECE(^(0),"^",1),1:"")
IF XX']""
QUIT
+3 WRITE @IOF
SET DGRPCM=1
SET Z="LOCAL REGISTRATION QUESTIONS"
SET X=25
DO W^DGRPU
+4 SET X1=""
SET $PIECE(X1,"=",81)=""
WRITE !,X1,!!
+5 SET DR="["_XX_"]"
SET DIE="^DPT("
SET (DA,Y)=DFN
DO ^DIE
+6 KILL XX
QUIT
+7 ;
JUMP ;jump screens (^N)
+1 ;DG*5.3*997; added 11.5 flow
SET X=+$EXTRACT(DGRPANN,2,99)
IF $DATA(DGRPVV(X))
SET X1=$EXTRACT(DGRPVV,$PIECE(X,"."))
IF X1]""
IF 'X1
GOTO @$SELECT(X=1.1:"^DGRPCADD",X=11.5:"^DGRP11A",1:"^DGRP"_X)
+2 ;LEG; DG*5.3*997; modified display as it was too long for the number of screens identified
+3 ;S Z="INVALID SCREEN NUMBER...VALID SCREENS ARE " F I=1,1.1,2:1:DGRPLAST I '$E(DGRPVV,I) S Z=Z_$S(I=DGRPLAST:" and ",1:"")_I_$S(I<DGRPLAST:",",1:".")
+4 SET Z="INVALID ENTRY...VALID SCREEN #s: "
FOR I=1,1.1,2:1:11,11.5,12:1:DGRPLAST
IF '$EXTRACT(DGRPVV,I)
SET Z=Z_I_$SELECT(I<DGRPLAST:",",1:".")
+5 WRITE !,*7
DO W
HANG 2
+6 ;return to same screen
if DGRPS=1.1
GOTO ^DGRPCADD
+7 ;DG*5.3*997; added 11.5 flow
if DGRPS["11.5"
GOTO ^DGRP11A
+8 if DGRPS'=1.1
GOTO @("^DGRP"_DGRPS)
+9 ;
WHICH ; if screen 9, which elements can be edited (vet, spouse, dependents)
+1 IF DGRPS'=9
SET DGRPSEL=""
QUIT
+2 SET DGRPSEL="V"
IF $DATA(DGREL("S"))
SET DGRPSEL=DGRPSEL_"S"
+3 IF $ORDER(DGREL("D",0))
SET DGRPSEL=DGRPSEL_"D"
+4 QUIT
+5 ;
MOREHLP ; print additional help prompt for screen 9
+1 ;view only
IF DGRPVV(9)'["0"!+$GET(DGRPV)
QUIT
+2 WRITE !,"(To edit only veteran income, precede selection with 'V' [ex. 'V1-3']"
IF DGRPSEL]"V"
WRITE $SELECT(DGRPSEL["SD":",",1:" or"),!
+3 IF DGRPSEL["S"
WRITE "precede with 'S' to edit spouse"
IF DGRPSEL["D"
WRITE ", or "
+4 IF DGRPSEL["D"
WRITE "precede with 'D' to edit dependents"
+5 WRITE "): "
+6 QUIT
+7 ;
W ;write highlighted text on screen (if parameter on)
+1 IF IOST="C-QUME"
IF $LENGTH(DGVI)'=2
WRITE Z
+2 IF '$TEST
WRITE @DGVI,Z,@DGVO
+3 QUIT
