DGRPP1.m

DGRPP1 ;ALB/MRL - REGISTRATION SCREEN PROCESSOR (CONTINUED) ;06 JUN 88@2300

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

 ;

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",1:"^DGRP"_X)

 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:".")

 W !,*7 D W H 2

 G:DGRPS'=1.1 @("^DGRP"_DGRPS) G:DGRPS=1.1 ^DGRPCADD  ;return to same screen

 ;

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

DGRPP1    ;ALB/MRL - REGISTRATION SCREEN PROCESSOR (CONTINUED) ;06 JUN 88@2300

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

 +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        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",1:"^DGRP"_X)

 +2        SET Z="INVALID SCREEN NUMBER...VALID SCREENS ARE "

           FOR I=1,1.1,2:1:DGRPLAST

               IF '$EXTRACT(DGRPVV,I)

                   SET Z=Z_$SELECT(I=DGRPLAST:" and ",1:"")_I_$SELECT(I<DGRPLAST:",",1:".")

 +3        WRITE !,*7

           DO W

           HANG 2

 +4       ;return to same screen

           IF DGRPS'=1.1

               GOTO @("^DGRP"_DGRPS)

           IF DGRPS=1.1

               GOTO ^DGRPCADD

 +5       ;

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