- DGMTSCR ;ALB/RMO/CAW,HM,JAM - Means Test Screen Read Processor ; 8/1/08 1:21pm
- ;;5.3;Registration;**45,688,1014,1064**;Aug 13, 1993;Build 41
- ;
- ; Input -- DGRNG Range of selectable items
- ; DGMTACT Means Test Action
- ; DGMTSC Screen Driver Array
- ; DGMTSCI Screen number
- ; DGVINI Veteran Individual Annual Income IEN
- ; DGVPRI Veteran Income Relation IEN
- ; Output -- DGDR Template tags (ie, 101,102,103,104)
- ; DGX User input - maybe modified (ie, 1-4)
- ; DGY Items selected in expanded form (ie, 1,2,3,4)
- ; Returned for screen 2 and 4:
- ; DGSEL Column selections available (ie, V, S, C)
- ; DGSELTY User input - column selected (ie, V or S or C)
- ;
- ; Reference to XQY0 in ICR #3356
- ;
- EN K DGDR,DGSEL,DGSELTY,DGX,DGY,I D FEED
- I $G(DGSCR1) S X="" G EN1
- W !,DGVI,"<RET>",DGVO," to CONTINUE," W:DGMTACT'="VEW" " ",DGVI,DGRNG,DGVO," or ",DGVI,"'ALL' ",DGVO,"to EDIT," W DGVI," ^N",DGVO," for screen N, or ",DGVI,"'^'",DGVO," to EXIT: " R X:DTIME S:'$T X="^"
- EN1 K DGSCR1 S DGX=$$UPPER^DGUTL(X)
- I DGX="^" G Q^DGMTSC
- I DGX?1"^".N,$D(DGMTSC(+$P(DGX,"^",2))) G @($$ROU^DGMTSCU(+$P(DGX,"^",2)))
- I DGMTACT'="VEW","^2^4^"[("^"_DGMTSCI_"^") D SEL I DGSEL[$E(DGX),$E(DGX,2)?1N S DGSELTY=$E(DGX),DGX=$P(DGX,DGSELTY,2)
- I DGMTACT'="VEW",$E(DGX)="A" S X=DGX,Z="^ALL" D IN^DGHELP S:%'=-1 DGX=DGRNG
- I DGX["?" D HLP G Q^DGMTSC:$D(DTOUT)!($D(DUOUT)),@($$ROU^DGMTSCU(DGMTSCI))
- I DGX="",$O(DGMTSC(DGMTSCI)) G @($$ROU^DGMTSCU($O(DGMTSC(DGMTSCI))))
- ; DG*5.3*1064 - If in View Past Co-Pay Test option, check patient's Indian status to print message
- I DGX="" D G Q^DGMTSC
- . I $P(XQY0,"^",1)="DG CO-PAY TEST VIEW TEST" I $$INDSTATUS^DGENELA2(DFN) D
- . . D BLD^DIALOG(261134,"","","","F")
- . . D MSG^DIALOG("WM","","","")
- I DGMTACT'="VEW" D PRO I $D(DGSELTY) S DGX=DGSELTY_DGX
- S:DGMTACT="VEW" DGERR=1 I DGERR D HLP G @($$ROU^DGMTSCU(DGMTSCI))
- Q G @($$ROURET^DGMTSCU(DGMTSCI))
- ;
- FEED ;Line feed to the bottom of the screen
- N DGB,I
- S DGB=$S('IOSL:24,1:IOSL)-5 F I=$Y:1:DGB W !
- Q
- ;
- SEL ;Check available column selections for Veteran, Spouse or Children
- N DGDC,DGNC,DGND,DGSP,DGVIR0,DGX
- D DEP^DGMTSCU2
- S DGSEL="V"_$S(DGSP:"S",1:"")_$S(DGDC:"C",1:"")
- SELQ Q
- ;
- HLP ;Help display
- N DGIOM,DGLNE,DGMTSCR,DIR,I,X
- S DGHLPF=1 D HD^DGMTSCU
- W !!,"Enter <RET> to continue to the next available screen."
- I DGMTACT'="VEW" W !,"Enter an available item number from ",DGRNG," to edit.",!,"The items should be separated by commas or a range of numbers",!,"separated by a dash, or a combination of commas and dashes."
- I DGMTACT'="VEW"&(DGMTSCI=2!(DGMTSCI=4))&($D(DGSEL)) W !,"To edit a specific column, enter 'V'",$S(DGSEL["S":", 'S'",1:""),$S(DGSEL["C":", 'C'",1:"")," in front of the selected items."
- I DGMTACT'="VEW" W !,"Enter 'ALL' to edit all available items on the screen."
- W !,"Enter '^N' to jump to a select screen. Enter '^' to exit."
- W !!,"AVAILABLE SCREENS"
- S I=0 F S I=$O(DGMTSC(I)) Q:'I D
- .I I=4,DGMTACT'="VEW" Q ;DG*5.3*1014 do not display screen 4 for help
- .W !,"[",+$$SCR^DGMTSCU(I),"] ",$P($$SCR^DGMTSCU(I),";",2)
- S DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))=""
- W !,DGLNE S DIR(0)="E" D ^DIR
- Q
- ;
- PRO ;Process user selection; cnt - dash - parse - selection
- N DGC,DGD,DGP,DGS
- S DGC=0,DGERR=0,DGY="",DGDR=""
- PARSE S DGC=DGC+1,DGP=$P(DGX,",",DGC) G PROQ:DGP=""
- I DGP?.N1"-".N S DGD="" F DGS=$P(DGP,"-"):1:$P(DGP,"-",2) D CHK Q:DGERR
- I '$D(DGD) S DGS=DGP D CHK
- K DGD G PROQ:DGERR,PARSE
- PROQ Q
- ;
- CHK I $D(DGD),+$P(DGP,"-",2)<+$P(DGP,"-",1) S DGERR=1
- I 'DGERR,DGS'?.N S DGERR=1
- I 'DGERR&(DGS>$P(DGRNG,"-",2)!(DGS<$P(DGRNG,"-"))) S DGERR=1
- I 'DGERR S DGY=DGY_$S($L(DGY):",",1:"")_DGS,DGDR=DGDR_$S($L(DGDR):",",1:"")_(DGS+100)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSCR 3867 printed Jan 18, 2025@03:46:07 Page 2
- DGMTSCR ;ALB/RMO/CAW,HM,JAM - Means Test Screen Read Processor ; 8/1/08 1:21pm
- +1 ;;5.3;Registration;**45,688,1014,1064**;Aug 13, 1993;Build 41
- +2 ;
- +3 ; Input -- DGRNG Range of selectable items
- +4 ; DGMTACT Means Test Action
- +5 ; DGMTSC Screen Driver Array
- +6 ; DGMTSCI Screen number
- +7 ; DGVINI Veteran Individual Annual Income IEN
- +8 ; DGVPRI Veteran Income Relation IEN
- +9 ; Output -- DGDR Template tags (ie, 101,102,103,104)
- +10 ; DGX User input - maybe modified (ie, 1-4)
- +11 ; DGY Items selected in expanded form (ie, 1,2,3,4)
- +12 ; Returned for screen 2 and 4:
- +13 ; DGSEL Column selections available (ie, V, S, C)
- +14 ; DGSELTY User input - column selected (ie, V or S or C)
- +15 ;
- +16 ; Reference to XQY0 in ICR #3356
- +17 ;
- EN KILL DGDR,DGSEL,DGSELTY,DGX,DGY,I
- DO FEED
- +1 IF $GET(DGSCR1)
- SET X=""
- GOTO EN1
- +2 WRITE !,DGVI,"<RET>",DGVO," to CONTINUE,"
- if DGMTACT'="VEW"
- WRITE " ",DGVI,DGRNG,DGVO," or ",DGVI,"'ALL' ",DGVO,"to EDIT,"
- WRITE DGVI," ^N",DGVO," for screen N, or ",DGVI,"'^'",DGVO," to EXIT: "
- READ X:DTIME
- if '$TEST
- SET X="^"
- EN1 KILL DGSCR1
- SET DGX=$$UPPER^DGUTL(X)
- +1 IF DGX="^"
- GOTO Q^DGMTSC
- +2 IF DGX?1"^".N
- IF $DATA(DGMTSC(+$PIECE(DGX,"^",2)))
- GOTO @($$ROU^DGMTSCU(+$PIECE(DGX,"^",2)))
- +3 IF DGMTACT'="VEW"
- IF "^2^4^"[("^"_DGMTSCI_"^")
- DO SEL
- IF DGSEL[$EXTRACT(DGX)
- IF $EXTRACT(DGX,2)?1N
- SET DGSELTY=$EXTRACT(DGX)
- SET DGX=$PIECE(DGX,DGSELTY,2)
- +4 IF DGMTACT'="VEW"
- IF $EXTRACT(DGX)="A"
- SET X=DGX
- SET Z="^ALL"
- DO IN^DGHELP
- if %'=-1
- SET DGX=DGRNG
- +5 IF DGX["?"
- DO HLP
- if $DATA(DTOUT)!($DATA(DUOUT))
- GOTO Q^DGMTSC
- GOTO @($$ROU^DGMTSCU(DGMTSCI))
- +6 IF DGX=""
- IF $ORDER(DGMTSC(DGMTSCI))
- GOTO @($$ROU^DGMTSCU($ORDER(DGMTSC(DGMTSCI))))
- +7 ; DG*5.3*1064 - If in View Past Co-Pay Test option, check patient's Indian status to print message
- +8 IF DGX=""
- Begin DoDot:1
- +9 IF $PIECE(XQY0,"^",1)="DG CO-PAY TEST VIEW TEST"
- IF $$INDSTATUS^DGENELA2(DFN)
- Begin DoDot:2
- +10 DO BLD^DIALOG(261134,"","","","F")
- +11 DO MSG^DIALOG("WM","","","")
- End DoDot:2
- End DoDot:1
- GOTO Q^DGMTSC
- +12 IF DGMTACT'="VEW"
- DO PRO
- IF $DATA(DGSELTY)
- SET DGX=DGSELTY_DGX
- +13 if DGMTACT="VEW"
- SET DGERR=1
- IF DGERR
- DO HLP
- GOTO @($$ROU^DGMTSCU(DGMTSCI))
- Q GOTO @($$ROURET^DGMTSCU(DGMTSCI))
- +1 ;
- FEED ;Line feed to the bottom of the screen
- +1 NEW DGB,I
- +2 SET DGB=$SELECT('IOSL:24,1:IOSL)-5
- FOR I=$Y:1:DGB
- WRITE !
- +3 QUIT
- +4 ;
- SEL ;Check available column selections for Veteran, Spouse or Children
- +1 NEW DGDC,DGNC,DGND,DGSP,DGVIR0,DGX
- +2 DO DEP^DGMTSCU2
- +3 SET DGSEL="V"_$SELECT(DGSP:"S",1:"")_$SELECT(DGDC:"C",1:"")
- SELQ QUIT
- +1 ;
- HLP ;Help display
- +1 NEW DGIOM,DGLNE,DGMTSCR,DIR,I,X
- +2 SET DGHLPF=1
- DO HD^DGMTSCU
- +3 WRITE !!,"Enter <RET> to continue to the next available screen."
- +4 IF DGMTACT'="VEW"
- WRITE !,"Enter an available item number from ",DGRNG," to edit.",!,"The items should be separated by commas or a range of numbers",!,"separated by a dash, or a combination of commas and dashes."
- +5 IF DGMTACT'="VEW"&(DGMTSCI=2!(DGMTSCI=4))&($DATA(DGSEL))
- WRITE !,"To edit a specific column, enter 'V'",$SELECT(DGSEL["S":", 'S'",1:""),$SELECT(DGSEL["C":", 'C'",1:"")," in front of the selected items."
- +6 IF DGMTACT'="VEW"
- WRITE !,"Enter 'ALL' to edit all available items on the screen."
- +7 WRITE !,"Enter '^N' to jump to a select screen. Enter '^' to exit."
- +8 WRITE !!,"AVAILABLE SCREENS"
- +9 SET I=0
- FOR
- SET I=$ORDER(DGMTSC(I))
- if 'I
- QUIT
- Begin DoDot:1
- +10 ;DG*5.3*1014 do not display screen 4 for help
- IF I=4
- IF DGMTACT'="VEW"
- QUIT
- +11 WRITE !,"[",+$$SCR^DGMTSCU(I),"] ",$PIECE($$SCR^DGMTSCU(I),";",2)
- End DoDot:1
- +12 SET DGLNE=""
- SET DGIOM=$SELECT('IOM:80,1:IOM)
- SET $PIECE(DGLNE,"=",(DGIOM-1))=""
- +13 WRITE !,DGLNE
- SET DIR(0)="E"
- DO ^DIR
- +14 QUIT
- +15 ;
- PRO ;Process user selection; cnt - dash - parse - selection
- +1 NEW DGC,DGD,DGP,DGS
- +2 SET DGC=0
- SET DGERR=0
- SET DGY=""
- SET DGDR=""
- PARSE SET DGC=DGC+1
- SET DGP=$PIECE(DGX,",",DGC)
- if DGP=""
- GOTO PROQ
- +1 IF DGP?.N1"-".N
- SET DGD=""
- FOR DGS=$PIECE(DGP,"-"):1:$PIECE(DGP,"-",2)
- DO CHK
- if DGERR
- QUIT
- +2 IF '$DATA(DGD)
- SET DGS=DGP
- DO CHK
- +3 KILL DGD
- if DGERR
- GOTO PROQ
- GOTO PARSE
- PROQ QUIT
- +1 ;
- CHK IF $DATA(DGD)
- IF +$PIECE(DGP,"-",2)<+$PIECE(DGP,"-",1)
- SET DGERR=1
- +1 IF 'DGERR
- IF DGS'?.N
- SET DGERR=1
- +2 IF 'DGERR&(DGS>$PIECE(DGRNG,"-",2)!(DGS<$PIECE(DGRNG,"-")))
- SET DGERR=1
- +3 IF 'DGERR
- SET DGY=DGY_$SELECT($LENGTH(DGY):",",1:"")_DGS
- SET DGDR=DGDR_$SELECT($LENGTH(DGDR):",",1:"")_(DGS+100)
- +4 QUIT