- DGMTSCU ;ALB/RMO/CAW,LBD - Means Test Screen Driver Utilities ;21 JAN 1992 8:00 pm
- ;;5.3;Registration;**456,688**;Aug 13, 1993;Build 29
- ;
- SETUP ;Set-up the screen driver array and required screen variables
- ; Input -- DFN Patient IEN
- ; DGMTDT Date of Test
- ; DGMTYPT Type of Test
- ; Output -- DGMTSC Screen Driver Array
- ; DGVPRI Veteran Patient Relation IEN
- ; DGVINI Veteran Individual Annual Income IEN
- ; DGVIRI Veteran Income Relation IEN
- ; DGMTPAR Annual Means Test Parameter Array
- ; DGMTGMT GMT Threshold Values
- ; DGMTNWC Net Worth Calculation flag
- ; DGERR 1=ERROR and 0=NO ERROR
- N DGINI,DGIRI,DGLY,DGPRI,DGPRTY,DGSCR,I,X
- K DGMTSC S DGERR=0,DGLY=$$LYR^DGMTSCU1(DGMTDT)
- S DGSCR=$S(DGMTYPT=1:5,DGMTYPT=2&($$ASKNW^DGMTCOU):5,1:4)
- ;
- ;* Check version; IF pre 2005 form, call version 0 input
- I (+$P($G(^DGMT(408.31,DGMTI,2)),"^",11)=0) DO
- . F I=1:1 S X=$P($T(SCRNS+I),";;",2) Q:X="QUIT"!(+X=DGSCR) S DGMTSC(+X)=X
- ;* Check version; IF Feb-2005 form, call version 1 input
- I (+$P($G(^DGMT(408.31,DGMTI,2)),"^",11)=1) DO
- . F I=1:1 S X=$P($T(SCRNS1+I),";;",2) Q:X="QUIT"!(+X=DGSCR) S DGMTSC(+X)=X
- ;
- D NEW^DGRPEIS1 S:DGPRI'>0 DGERR=1 G Q:DGERR S DGVPRI=DGPRI
- D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) G Q:DGERR S DGVINI=DGINI,DGVIRI=DGIRI
- D PAR S:DGMTPAR="" DGERR=1
- Q Q
- ;
- PAR ;Annual Means Test Parameters
- ; Input -- DGLY Last Year
- ; Output -- DGMTPAR Means Test Parameter 0th node
- ; DGMTGMT GMT Threshold values
- ; DGMTNWC Net Worth Calculation flag
- ; Returned if the current year's parameters are not available:
- ; DGMTPAR("PREV") Previous Year Income Parameters
- N GMT
- S DGMTPAR=$S($D(^DG(43,1,"MT",DGLY+10000,0)):^(0),1:"")
- I DGMTPAR']"",$D(^DG(43,1,"MT",DGLY,0)) S DGMTPAR=^(0),DGMTPAR("PREV")=""
- ; Get Net Worth Calculation flag
- S DGMTNWC=+$G(^DG(43,1,"GMT"))
- ; Get GMT Threshold values for this veteran
- S DGMTGMT=""
- D GETFIPS^EASAILK(DFN,DGLY,.GMT)
- I '$G(GMT("GMTIEN")) Q
- S DGMTGMT=$G(^EAS(712.5,GMT("GMTIEN"),1))
- Q
- ;
- HD ;Print screen header
- ; Input -- DGMTSCI Screen number
- ; DGVPRI Veteran Patient Relation IEN
- ; DGMTDT Date of Test
- ; DGHLPF Help Flag (Optional)
- ; Output -- Screen Header
- N DGHDR,DGIOM,DGLNE,DGMTSCR,DGTAB,Y
- S:'$D(DGHLPF) DGHLPF=0
- S DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))=""
- S DGHDR=$P($$SCR(DGMTSCI),";",2)_", SCREEN <"_+$$SCR(DGMTSCI)_"> "_$S(DGHLPF:"HELP",1:"")
- S DGTAB=DGIOM-$L(DGHDR)\2
- S (DGVI,DGVO)="" I $S('$D(IOST(0)):1,'$D(^DG(43,1,0)):1,'$P(^DG(43,1,0),"^",36):1,$D(^DG(43,1,"TERM",IOST(0))):1,1:0) G HDNH ;goto HDNH if not high intensity
- S X="IOINHI;IOINLOW" D ENDR^%ZISS K X S DGVI=IOINHI,DGVO=IOINLOW S X=132 X ^%ZOSF("RM")
- HDNH ;
- W @IOF W ?DGTAB,DGVI,DGHDR,DGVO
- I 'DGHLPF W !,$$NAME^DGMTU1(DGVPRI)," ",$$SSN^DGMTU1(DGVPRI),?(DGIOM-24),"ANNUAL INCOME FOR " S Y=$$LYR^DGMTSCU1(DGMTDT) X ^DD("DD") W Y
- W !,DGLNE
- K DGHLPF Q
- ;
- SCR(DGMTSCI) ;Screen name and number
- ; Input -- DGMTSCI Screen number
- ; Output -- Screen number;Screen name
- N DGMTSCR
- S DGMTSCR=$P($G(DGMTSC(DGMTSCI)),";",1,2)
- Q $G(DGMTSCR)
- ;
- ROU(DGMTSCI) ;Screen entry routine
- ; Input -- DGMTSCI Screen number
- ; Output -- Routine name
- N DGROU
- S DGROU=$P($G(DGMTSC(DGMTSCI)),";",3)
- Q $G(DGROU)
- ;
- ROURET(DGMTSCI) ;Screen read processor return routine
- ; Input -- DGMTSCI Screen number
- ; Output -- Routine name
- N DGROU
- S DGROU=$P($G(DGMTSC(DGMTSCI)),";",4)
- Q $G(DGROU)
- ;
- ;Version 0 screen processing
- SCRNS ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
- ;;1;MARITAL STATUS/DEPENDENTS;EN^DGMTSC1;EN1^DGMTSC1
- ;;2;PREVIOUS CALENDAR YEAR GROSS INCOME;EN^DGMTSC2;EN1^DGMTSC2
- ;;3;DEDUCTIBLE EXPENSES;EN^DGMTSC3;EN1^DGMTSC3
- ;;4;PREVIOUS CALENDAR YEAR NET WORTH;EN^DGMTSC4;EN1^DGMTSC4
- ;;QUIT
- ;
- ;Version 1 screen processing
- SCRNS1 ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
- ;;1;MARITAL STATUS/DEPENDENTS;EN^DGMTSC1;EN1^DGMTSC1
- ;;2;PREVIOUS CALENDAR YEAR GROSS INCOME;EN^DGMTSC2V;EN1^DGMTSC2V
- ;;3;DEDUCTIBLE EXPENSES;EN^DGMTSC3V;EN1^DGMTSC3V
- ;;4;PREVIOUS CALENDAR YEAR NET WORTH;EN^DGMTSC4V;EN1^DGMTSC4V
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSCU 4509 printed Jan 18, 2025@03:46:08 Page 2
- DGMTSCU ;ALB/RMO/CAW,LBD - Means Test Screen Driver Utilities ;21 JAN 1992 8:00 pm
- +1 ;;5.3;Registration;**456,688**;Aug 13, 1993;Build 29
- +2 ;
- SETUP ;Set-up the screen driver array and required screen variables
- +1 ; Input -- DFN Patient IEN
- +2 ; DGMTDT Date of Test
- +3 ; DGMTYPT Type of Test
- +4 ; Output -- DGMTSC Screen Driver Array
- +5 ; DGVPRI Veteran Patient Relation IEN
- +6 ; DGVINI Veteran Individual Annual Income IEN
- +7 ; DGVIRI Veteran Income Relation IEN
- +8 ; DGMTPAR Annual Means Test Parameter Array
- +9 ; DGMTGMT GMT Threshold Values
- +10 ; DGMTNWC Net Worth Calculation flag
- +11 ; DGERR 1=ERROR and 0=NO ERROR
- +12 NEW DGINI,DGIRI,DGLY,DGPRI,DGPRTY,DGSCR,I,X
- +13 KILL DGMTSC
- SET DGERR=0
- SET DGLY=$$LYR^DGMTSCU1(DGMTDT)
- +14 SET DGSCR=$SELECT(DGMTYPT=1:5,DGMTYPT=2&($$ASKNW^DGMTCOU):5,1:4)
- +15 ;
- +16 ;* Check version; IF pre 2005 form, call version 0 input
- +17 IF (+$PIECE($GET(^DGMT(408.31,DGMTI,2)),"^",11)=0)
- Begin DoDot:1
- +18 FOR I=1:1
- SET X=$PIECE($TEXT(SCRNS+I),";;",2)
- if X="QUIT"!(+X=DGSCR)
- QUIT
- SET DGMTSC(+X)=X
- End DoDot:1
- +19 ;* Check version; IF Feb-2005 form, call version 1 input
- +20 IF (+$PIECE($GET(^DGMT(408.31,DGMTI,2)),"^",11)=1)
- Begin DoDot:1
- +21 FOR I=1:1
- SET X=$PIECE($TEXT(SCRNS1+I),";;",2)
- if X="QUIT"!(+X=DGSCR)
- QUIT
- SET DGMTSC(+X)=X
- End DoDot:1
- +22 ;
- +23 DO NEW^DGRPEIS1
- if DGPRI'>0
- SET DGERR=1
- if DGERR
- GOTO Q
- SET DGVPRI=DGPRI
- +24 DO GETIENS^DGMTU2(DFN,DGPRI,DGMTDT)
- if DGERR
- GOTO Q
- SET DGVINI=DGINI
- SET DGVIRI=DGIRI
- +25 DO PAR
- if DGMTPAR=""
- SET DGERR=1
- Q QUIT
- +1 ;
- PAR ;Annual Means Test Parameters
- +1 ; Input -- DGLY Last Year
- +2 ; Output -- DGMTPAR Means Test Parameter 0th node
- +3 ; DGMTGMT GMT Threshold values
- +4 ; DGMTNWC Net Worth Calculation flag
- +5 ; Returned if the current year's parameters are not available:
- +6 ; DGMTPAR("PREV") Previous Year Income Parameters
- +7 NEW GMT
- +8 SET DGMTPAR=$SELECT($DATA(^DG(43,1,"MT",DGLY+10000,0)):^(0),1:"")
- +9 IF DGMTPAR']""
- IF $DATA(^DG(43,1,"MT",DGLY,0))
- SET DGMTPAR=^(0)
- SET DGMTPAR("PREV")=""
- +10 ; Get Net Worth Calculation flag
- +11 SET DGMTNWC=+$GET(^DG(43,1,"GMT"))
- +12 ; Get GMT Threshold values for this veteran
- +13 SET DGMTGMT=""
- +14 DO GETFIPS^EASAILK(DFN,DGLY,.GMT)
- +15 IF '$GET(GMT("GMTIEN"))
- QUIT
- +16 SET DGMTGMT=$GET(^EAS(712.5,GMT("GMTIEN"),1))
- +17 QUIT
- +18 ;
- HD ;Print screen header
- +1 ; Input -- DGMTSCI Screen number
- +2 ; DGVPRI Veteran Patient Relation IEN
- +3 ; DGMTDT Date of Test
- +4 ; DGHLPF Help Flag (Optional)
- +5 ; Output -- Screen Header
- +6 NEW DGHDR,DGIOM,DGLNE,DGMTSCR,DGTAB,Y
- +7 if '$DATA(DGHLPF)
- SET DGHLPF=0
- +8 SET DGLNE=""
- SET DGIOM=$SELECT('IOM:80,1:IOM)
- SET $PIECE(DGLNE,"=",(DGIOM-1))=""
- +9 SET DGHDR=$PIECE($$SCR(DGMTSCI),";",2)_", SCREEN <"_+$$SCR(DGMTSCI)_"> "_$SELECT(DGHLPF:"HELP",1:"")
- +10 SET DGTAB=DGIOM-$LENGTH(DGHDR)\2
- +11 ;goto HDNH if not high intensity
- SET (DGVI,DGVO)=""
- IF $SELECT('$DATA(IOST(0)):1,'$DATA(^DG(43,1,0)):1,'$PIECE(^DG(43,1,0),"^",36):1,$DATA(^DG(43,1,"TERM",IOST(0))):1,1:0)
- GOTO HDNH
- +12 SET X="IOINHI;IOINLOW"
- DO ENDR^%ZISS
- KILL X
- SET DGVI=IOINHI
- SET DGVO=IOINLOW
- SET X=132
- XECUTE ^%ZOSF("RM")
- HDNH ;
- +1 WRITE @IOF
- WRITE ?DGTAB,DGVI,DGHDR,DGVO
- +2 IF 'DGHLPF
- WRITE !,$$NAME^DGMTU1(DGVPRI)," ",$$SSN^DGMTU1(DGVPRI),?(DGIOM-24),"ANNUAL INCOME FOR "
- SET Y=$$LYR^DGMTSCU1(DGMTDT)
- XECUTE ^DD("DD")
- WRITE Y
- +3 WRITE !,DGLNE
- +4 KILL DGHLPF
- QUIT
- +5 ;
- SCR(DGMTSCI) ;Screen name and number
- +1 ; Input -- DGMTSCI Screen number
- +2 ; Output -- Screen number;Screen name
- +3 NEW DGMTSCR
- +4 SET DGMTSCR=$PIECE($GET(DGMTSC(DGMTSCI)),";",1,2)
- +5 QUIT $GET(DGMTSCR)
- +6 ;
- ROU(DGMTSCI) ;Screen entry routine
- +1 ; Input -- DGMTSCI Screen number
- +2 ; Output -- Routine name
- +3 NEW DGROU
- +4 SET DGROU=$PIECE($GET(DGMTSC(DGMTSCI)),";",3)
- +5 QUIT $GET(DGROU)
- +6 ;
- ROURET(DGMTSCI) ;Screen read processor return routine
- +1 ; Input -- DGMTSCI Screen number
- +2 ; Output -- Routine name
- +3 NEW DGROU
- +4 SET DGROU=$PIECE($GET(DGMTSC(DGMTSCI)),";",4)
- +5 QUIT $GET(DGROU)
- +6 ;
- +7 ;Version 0 screen processing
- SCRNS ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
- +1 ;;1;MARITAL STATUS/DEPENDENTS;EN^DGMTSC1;EN1^DGMTSC1
- +2 ;;2;PREVIOUS CALENDAR YEAR GROSS INCOME;EN^DGMTSC2;EN1^DGMTSC2
- +3 ;;3;DEDUCTIBLE EXPENSES;EN^DGMTSC3;EN1^DGMTSC3
- +4 ;;4;PREVIOUS CALENDAR YEAR NET WORTH;EN^DGMTSC4;EN1^DGMTSC4
- +5 ;;QUIT
- +6 ;
- +7 ;Version 1 screen processing
- SCRNS1 ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
- +1 ;;1;MARITAL STATUS/DEPENDENTS;EN^DGMTSC1;EN1^DGMTSC1
- +2 ;;2;PREVIOUS CALENDAR YEAR GROSS INCOME;EN^DGMTSC2V;EN1^DGMTSC2V
- +3 ;;3;DEDUCTIBLE EXPENSES;EN^DGMTSC3V;EN1^DGMTSC3V
- +4 ;;4;PREVIOUS CALENDAR YEAR NET WORTH;EN^DGMTSC4V;EN1^DGMTSC4V
- +5 ;;QUIT