- EASECSCU ;ALB/LBD - LTC Co-Pay Test Screen Driver Utilities ;10 AUG 2001
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,40**;Mar 15, 2001
- ;
- ;NOTE: This routine was modified from DGMTSCU for LTC Co-pay
- 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
- ; DGFORM 10-10EC Form (1=Revised; 0=Original)
- ; 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)
- F I=1:1 S X=$P($T(SCRNS+I),";;",2) Q:X="QUIT" S DGMTSC(+X)=X
- D NEW^EASECED1 S:DGPRI'>0 DGERR=1 G Q:DGERR S DGVPRI=DGPRI
- D GETIENS^EASECU2(DFN,DGPRI,DGMTDT) G Q:DGERR S DGVINI=DGINI,DGVIRI=DGIRI
- D PAR S:DGMTPAR="" DGERR=1
- ; Set DGFORM to indicate which 10-10EC form was used to complete
- ; the LTC copay test. If DGFORM=1 the revised format will be used
- ; for the LTC copay test screens, otherwise the original format is
- ; used. Added for LTC IV (EAS*1*40).
- S DGFORM=$$FORM^EASECU($G(DGMTI))
- Q Q
- ;
- PAR ;Annual Means Test Parameters
- ; Input -- DGLY Last Year
- ; Output -- DGMTPAR Means Test Parameter 0th node
- ; Returned if the current year's parameters are not available:
- ; DGMTPAR("PREV") Previous Year Income Parameters
- 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")=""
- 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,IOINHI,IOINLOW
- 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-26),"LTC COPAY TEST FOR " S Y=$E(DGMTDT,1,3)_"0000" 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)
- ;
- SCRNS ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
- ;;1;MILITARY SERVICE DATA;EN^EASECSC1;EN1^EASECSC1
- ;;2;INSURANCE DATA;EN^EASECSC2;EN1^EASECSC2
- ;;3;MARITAL STATUS/DEPENDENTS;EN^EASECSC3;EN1^EASECSC3
- ;;4;FIXED AND LIQUID ASSETS;EN^EASECSC4;EN1^EASECSC4
- ;;5;CURRENT CALENDAR YEAR GROSS INCOME;EN^EASECSC5;EN1^EASECSC5
- ;;6;DEDUCTIBLE EXPENSES;EN^EASECSC6;EN1^EASECSC6
- ;;QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECSCU 3804 printed Feb 18, 2025@23:20:41 Page 2
- EASECSCU ;ALB/LBD - LTC Co-Pay Test Screen Driver Utilities ;10 AUG 2001
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,40**;Mar 15, 2001
- +2 ;
- +3 ;NOTE: This routine was modified from DGMTSCU for LTC Co-pay
- 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 ; DGFORM 10-10EC Form (1=Revised; 0=Original)
- +10 ; DGERR 1=ERROR and 0=NO ERROR
- +11 NEW DGINI,DGIRI,DGLY,DGPRI,DGPRTY,DGSCR,I,X
- +12 KILL DGMTSC
- SET DGERR=0
- SET DGLY=$$LYR^DGMTSCU1(DGMTDT)
- +13 FOR I=1:1
- SET X=$PIECE($TEXT(SCRNS+I),";;",2)
- if X="QUIT"
- QUIT
- SET DGMTSC(+X)=X
- +14 DO NEW^EASECED1
- if DGPRI'>0
- SET DGERR=1
- if DGERR
- GOTO Q
- SET DGVPRI=DGPRI
- +15 DO GETIENS^EASECU2(DFN,DGPRI,DGMTDT)
- if DGERR
- GOTO Q
- SET DGVINI=DGINI
- SET DGVIRI=DGIRI
- +16 DO PAR
- if DGMTPAR=""
- SET DGERR=1
- +17 ; Set DGFORM to indicate which 10-10EC form was used to complete
- +18 ; the LTC copay test. If DGFORM=1 the revised format will be used
- +19 ; for the LTC copay test screens, otherwise the original format is
- +20 ; used. Added for LTC IV (EAS*1*40).
- +21 SET DGFORM=$$FORM^EASECU($GET(DGMTI))
- Q QUIT
- +1 ;
- PAR ;Annual Means Test Parameters
- +1 ; Input -- DGLY Last Year
- +2 ; Output -- DGMTPAR Means Test Parameter 0th node
- +3 ; Returned if the current year's parameters are not available:
- +4 ; DGMTPAR("PREV") Previous Year Income Parameters
- +5 SET DGMTPAR=$SELECT($DATA(^DG(43,1,"MT",DGLY+10000,0)):^(0),1:"")
- +6 IF DGMTPAR']""
- IF $DATA(^DG(43,1,"MT",DGLY,0))
- SET DGMTPAR=^(0)
- SET DGMTPAR("PREV")=""
- +7 QUIT
- +8 ;
- 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,IOINHI,IOINLOW
- +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-26),"LTC COPAY TEST FOR "
- SET Y=$EXTRACT(DGMTDT,1,3)_"0000"
- 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 ;
- SCRNS ;Screen Number;Screen Name;Screen Entry Routine;Reader Return Routine
- +1 ;;1;MILITARY SERVICE DATA;EN^EASECSC1;EN1^EASECSC1
- +2 ;;2;INSURANCE DATA;EN^EASECSC2;EN1^EASECSC2
- +3 ;;3;MARITAL STATUS/DEPENDENTS;EN^EASECSC3;EN1^EASECSC3
- +4 ;;4;FIXED AND LIQUID ASSETS;EN^EASECSC4;EN1^EASECSC4
- +5 ;;5;CURRENT CALENDAR YEAR GROSS INCOME;EN^EASECSC5;EN1^EASECSC5
- +6 ;;6;DEDUCTIBLE EXPENSES;EN^EASECSC6;EN1^EASECSC6
- +7 ;;QUIT