Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMTSCR

DGMTSCR.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Input -- DGRNG Range of selectable items
  1. ; DGMTACT Means Test Action
  1. ; DGMTSC Screen Driver Array
  1. ; DGMTSCI Screen number
  1. ; DGVINI Veteran Individual Annual Income IEN
  1. ; DGVPRI Veteran Income Relation IEN
  1. ; Output -- DGDR Template tags (ie, 101,102,103,104)
  1. ; DGX User input - maybe modified (ie, 1-4)
  1. ; DGY Items selected in expanded form (ie, 1,2,3,4)
  1. ; Returned for screen 2 and 4:
  1. ; DGSEL Column selections available (ie, V, S, C)
  1. ; DGSELTY User input - column selected (ie, V or S or C)
  1. ;
  1. ; Reference to XQY0 in ICR #3356
  1. ;
  1. EN K DGDR,DGSEL,DGSELTY,DGX,DGY,I D FEED
  1. I $G(DGSCR1) S X="" G EN1
  1. 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="^"
  1. EN1 K DGSCR1 S DGX=$$UPPER^DGUTL(X)
  1. I DGX="^" G Q^DGMTSC
  1. I DGX?1"^".N,$D(DGMTSC(+$P(DGX,"^",2))) G @($$ROU^DGMTSCU(+$P(DGX,"^",2)))
  1. 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)
  1. I DGMTACT'="VEW",$E(DGX)="A" S X=DGX,Z="^ALL" D IN^DGHELP S:%'=-1 DGX=DGRNG
  1. I DGX["?" D HLP G Q^DGMTSC:$D(DTOUT)!($D(DUOUT)),@($$ROU^DGMTSCU(DGMTSCI))
  1. I DGX="",$O(DGMTSC(DGMTSCI)) G @($$ROU^DGMTSCU($O(DGMTSC(DGMTSCI))))
  1. ; DG*5.3*1064 - If in View Past Co-Pay Test option, check patient's Indian status to print message
  1. I DGX="" D G Q^DGMTSC
  1. . I $P(XQY0,"^",1)="DG CO-PAY TEST VIEW TEST" I $$INDSTATUS^DGENELA2(DFN) D
  1. . . D BLD^DIALOG(261134,"","","","F")
  1. . . D MSG^DIALOG("WM","","","")
  1. I DGMTACT'="VEW" D PRO I $D(DGSELTY) S DGX=DGSELTY_DGX
  1. S:DGMTACT="VEW" DGERR=1 I DGERR D HLP G @($$ROU^DGMTSCU(DGMTSCI))
  1. Q G @($$ROURET^DGMTSCU(DGMTSCI))
  1. ;
  1. FEED ;Line feed to the bottom of the screen
  1. N DGB,I
  1. S DGB=$S('IOSL:24,1:IOSL)-5 F I=$Y:1:DGB W !
  1. Q
  1. ;
  1. SEL ;Check available column selections for Veteran, Spouse or Children
  1. N DGDC,DGNC,DGND,DGSP,DGVIR0,DGX
  1. D DEP^DGMTSCU2
  1. S DGSEL="V"_$S(DGSP:"S",1:"")_$S(DGDC:"C",1:"")
  1. SELQ Q
  1. ;
  1. HLP ;Help display
  1. N DGIOM,DGLNE,DGMTSCR,DIR,I,X
  1. S DGHLPF=1 D HD^DGMTSCU
  1. W !!,"Enter <RET> to continue to the next available screen."
  1. 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."
  1. 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."
  1. I DGMTACT'="VEW" W !,"Enter 'ALL' to edit all available items on the screen."
  1. W !,"Enter '^N' to jump to a select screen. Enter '^' to exit."
  1. W !!,"AVAILABLE SCREENS"
  1. S I=0 F S I=$O(DGMTSC(I)) Q:'I D
  1. .I I=4,DGMTACT'="VEW" Q ;DG*5.3*1014 do not display screen 4 for help
  1. .W !,"[",+$$SCR^DGMTSCU(I),"] ",$P($$SCR^DGMTSCU(I),";",2)
  1. S DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))=""
  1. W !,DGLNE S DIR(0)="E" D ^DIR
  1. Q
  1. ;
  1. PRO ;Process user selection; cnt - dash - parse - selection
  1. N DGC,DGD,DGP,DGS
  1. S DGC=0,DGERR=0,DGY="",DGDR=""
  1. PARSE S DGC=DGC+1,DGP=$P(DGX,",",DGC) G PROQ:DGP=""
  1. I DGP?.N1"-".N S DGD="" F DGS=$P(DGP,"-"):1:$P(DGP,"-",2) D CHK Q:DGERR
  1. I '$D(DGD) S DGS=DGP D CHK
  1. K DGD G PROQ:DGERR,PARSE
  1. PROQ Q
  1. ;
  1. CHK I $D(DGD),+$P(DGP,"-",2)<+$P(DGP,"-",1) S DGERR=1
  1. I 'DGERR,DGS'?.N S DGERR=1
  1. I 'DGERR&(DGS>$P(DGRNG,"-",2)!(DGS<$P(DGRNG,"-"))) S DGERR=1
  1. I 'DGERR S DGY=DGY_$S($L(DGY):",",1:"")_DGS,DGDR=DGDR_$S($L(DGDR):",",1:"")_(DGS+100)
  1. Q