EASEC10E ;ALB/BRM,LBD - Print 1010EC LTC Enrollment form ; 9/20/01 1:46pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,40**;Mar 15, 2001
;
; The EASEC10* routines print a version of the OMB approved
; VA10-10EC form (Long Term Care).
;
; No Local modifications to these routines will be made. Any changes
; will be provided through the National Patch Module release process.
;
Q
OEN ;Entry point to print an LTC Co-Pay test from the menu option
;
N DIC,DFN,DGMTI,ZTSK,DGMSGF
S DGMSGF=1 ;this flag is set to suppress the financial query
S DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S DFN=+Y
S DIC("A")="Select DATE OF TEST: "
I $D(^DGMT(408.31,+$$LST^EASECU(DFN,"",3),0)) S DIC("B")=$P(^(0),"^")
S DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=3"
S DIC="^DGMT(408.31,",DIC(0)="EQZ" W ! D EN^DGMTLK K DIC G Q:Y<0
S DGMTI=+Y
S ZTSK=$$QUE(DFN,DGMTI)
Q Q
QUE(DFN,DGMTIEN) ; queue the 1010EC print job
; Input:
; DFN - Internal entry number for the #2 (Patient) file
; Output:
; ZTSK - Task Number returned from call to Task Manager
;
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR
W !!?5,$C(7),"This output requires a 132 column printer."
W !?5,"Output to SCREEN will be unreadable.",!
K IOP,%ZIS
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D Q +$G(ZTSK)
.S ZTSAVE("ZUSR")=+$G(DUZ)
.S ZTRTN="EN^EASEC10E("_DFN_","_$G(DGMTIEN)_")",ZTDESC="1010EC PRINT"
.D ^%ZTLOAD
.D ^%ZISC,HOME^%ZIS
.W !,$S($D(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
D EN(DFN,$G(DGMTIEN))
EXIT D ^%ZISC,HOME^%ZIS
Q +$G(ZTSK)
;
EN(EASDFN,DGMTIEN) ; Entry point to print the 1010EC form
; Input:
; EASDFN - Internal entry number for the #2 (Patient) file
; DTMTDT - Date of Long Term Care Test to print
; DGMTIEN - IEN of the Long term Care test in the #408.31 file
;
U IO
Q:'$G(EASDFN)
N EALNE,EAINFO
S:$G(DGMTIEN) EAINFO("DGMTIEN")=DGMTIEN
; set-up print variables
D SETUP(.EALNE,.EAINFO,EASDFN)
; get veteran data to be printed
D GETDATA^EASEC100(EASDFN,.EAINFO)
; print page 1
D PAGE1^EASEC101(.EALNE,.EAINFO,EASDFN)
; print pages 2 and 3
I $G(EAINFO("FORM")) D G ENQUIT
.; new 10-10EC format (LTC Phase IV - EAS*1*40)
.D PAGE2^EASEC10R(.EALNE,.EAINFO,EASDFN)
.D PAGE3^EASEC10R(.EALNE,.EAINFO,EASDFN)
E D
.; old 10-10EC format
.D PAGE2^EASEC102(.EALNE,.EAINFO,EASDFN)
.D PAGE3^EASEC103(.EALNE,.EAINFO,EASDFN)
;
ENQUIT ; cleanup temp globals after printing has completed
K ^TMP("1010EC",$J,EASDFN)
Q
;
SETUP(EALNE,EAINFO,EASDFN) ;setup print variables
; Input:
; EALNE - Line format array
; EAINFO - Misc data array
; ("CLRK") - Clerk's Initials
; ("PGE") - Page number
; ("PD") - Print Date
; ("VET") - Veteran's Name
; ("SSN") - Veteran's SSN
; ("MTDT") - Long Term Care Test date
; ("DGMTIEN") - ien of LTC Test in 408.31
; EASDFN - DFN of applicant in the Patient file (#2)
;
N X,SSN
;
;Build Line array for printout
S EALNE("ULC")=$S('($D(IOST)#2):"-",IOST["C-":"-",1:"_")
S EALNE("D")="",EALNE("DD")="",EALNE("UL")=""
S $P(EALNE("D"),"-",131)="",$P(EALNE("DD"),"=",131)="",$P(EALNE("UL"),EALNE("ULC"),131)=""
S EAINFO("L")="W !,EALNE(""UL"")"
S:EALNE("ULC")'="-" EAINFO("L")=$TR(EAINFO("L"),"!,")
;
;Get clerk's initials
S ZUSR=$G(ZUSR)
S:$G(ZUSR)="" ZUSR=$G(DUZ)
I +ZUSR>0 D
.S EAINFO("CLRK")=$$GET1^DIQ(200,ZUSR,1)
.I EAINFO("CLRK")']"" D
..S X=$$GET1^DIQ(200,ZUSR,.01)
..S EAINFO("CLRK")=$E($P(X,",",2),1)_$E($P(X,","),1)
E D
.S EAINFO("CLRK")="unk"
;
;Get LTC Test date (if it is not passed, use latest LTC test date)
I $G(EAINFO("DGMTIEN")) S EAINFO("MTDT")=$$GET1^DIQ(408.31,EAINFO("DGMTIEN"),.01,"I")
E D ;
.N MTDTNEG
.S MTDTNEG=+$O(^DGMT(408.31,"AID",3,EASDFN,""))
.S EAINFO("MTDT")=$TR(MTDTNEG,"-")
.S EAINFO("DGMTIEN")=$O(^DGMT(408.31,"AID",3,EASDFN,MTDTNEG,""))
;
;Set data elements
S EAINFO("PGE")=0
S EAINFO("PD")=$$FMTE^XLFDT($$NOW^XLFDT)
S EAINFO("VET")=$$GET1^DIQ(2,EASDFN_",",.01)
S SSN=$$GET1^DIQ(2,EASDFN_",",.09)
S EAINFO("SSN")=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
;Line added to set new variable to indicate which version of the
;10-10EC form is to be printed. LTC Phase IV (EAS*1*40)
S EAINFO("FORM")=$$FORM^EASECU(EAINFO("DGMTIEN"))
Q
;
HDRMAIN(EALNE) ;
W @IOF
W !,EALNE("DD")
W !,"D E P A R T M E N T O F V E T E R A N S A F F A I R S",?90,"APPLICATION FOR EXTENDED CARE SERVICES",!,EALNE("DD")
W !?50,"SECTION I - GENERAL INFORMATION",!,EALNE("D")
Q
;
HDR(EALNE,EAINFO) ;
W @IOF
W EALNE("DD")
W !,"APPLICATION FOR EXTENDED CARE SERVICES, Continued"
W ?65,"| Veteran's Name",?100,"| Social Security Number"
W !?65,"| ",EAINFO("VET"),?100,"| ",EAINFO("SSN")
W !,EALNE("DD")
Q
;
FT(EALNE,EAINFO) ;
N %,Y
W !,EALNE("DD")
;Modified date printed on form if new 10-10EC format.
;Added for LTC Phase IV (EAS*1*40).
W !,"VA FORM 10-10EC DEC "_$S(EAINFO("FORM"):"2002",1:"2000"),?40,"PRINTED: ",EAINFO("PD")
W ?80,"Clerk: ",EAINFO("CLRK")
S EAINFO("PGE")=EAINFO("PGE")+1
W ?120,"Page ",EAINFO("PGE"),?131,$C(13)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEC10E 5257 printed Dec 13, 2024@01:53:46 Page 2
EASEC10E ;ALB/BRM,LBD - Print 1010EC LTC Enrollment form ; 9/20/01 1:46pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,40**;Mar 15, 2001
+2 ;
+3 ; The EASEC10* routines print a version of the OMB approved
+4 ; VA10-10EC form (Long Term Care).
+5 ;
+6 ; No Local modifications to these routines will be made. Any changes
+7 ; will be provided through the National Patch Module release process.
+8 ;
+9 QUIT
OEN ;Entry point to print an LTC Co-Pay test from the menu option
+1 ;
+2 NEW DIC,DFN,DGMTI,ZTSK,DGMSGF
+3 ;this flag is set to suppress the financial query
SET DGMSGF=1
+4 SET DIC("S")="I $D(^DGMT(408.31,""AID"",3,+Y))"
+5 SET DIC="^DPT("
SET DIC(0)="AEMQ"
WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO Q
SET DFN=+Y
+6 SET DIC("A")="Select DATE OF TEST: "
+7 IF $DATA(^DGMT(408.31,+$$LST^EASECU(DFN,"",3),0))
SET DIC("B")=$PIECE(^(0),"^")
+8 SET DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=3"
+9 SET DIC="^DGMT(408.31,"
SET DIC(0)="EQZ"
WRITE !
DO EN^DGMTLK
KILL DIC
if Y<0
GOTO Q
+10 SET DGMTI=+Y
+11 SET ZTSK=$$QUE(DFN,DGMTI)
Q QUIT
QUE(DFN,DGMTIEN) ; queue the 1010EC print job
+1 ; Input:
+2 ; DFN - Internal entry number for the #2 (Patient) file
+3 ; Output:
+4 ; ZTSK - Task Number returned from call to Task Manager
+5 ;
+6 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR
+7 WRITE !!?5,$CHAR(7),"This output requires a 132 column printer."
+8 WRITE !?5,"Output to SCREEN will be unreadable.",!
+9 KILL IOP,%ZIS
+10 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 SET ZTSAVE("ZUSR")=+$GET(DUZ)
+13 SET ZTRTN="EN^EASEC10E("_DFN_","_$GET(DGMTIEN)_")"
SET ZTDESC="1010EC PRINT"
+14 DO ^%ZTLOAD
+15 DO ^%ZISC
DO HOME^%ZIS
+16 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED!",1:"REQUEST CANCELLED!")
End DoDot:1
QUIT +$GET(ZTSK)
+17 DO EN(DFN,$GET(DGMTIEN))
EXIT DO ^%ZISC
DO HOME^%ZIS
+1 QUIT +$GET(ZTSK)
+2 ;
EN(EASDFN,DGMTIEN) ; Entry point to print the 1010EC form
+1 ; Input:
+2 ; EASDFN - Internal entry number for the #2 (Patient) file
+3 ; DTMTDT - Date of Long Term Care Test to print
+4 ; DGMTIEN - IEN of the Long term Care test in the #408.31 file
+5 ;
+6 USE IO
+7 if '$GET(EASDFN)
QUIT
+8 NEW EALNE,EAINFO
+9 if $GET(DGMTIEN)
SET EAINFO("DGMTIEN")=DGMTIEN
+10 ; set-up print variables
+11 DO SETUP(.EALNE,.EAINFO,EASDFN)
+12 ; get veteran data to be printed
+13 DO GETDATA^EASEC100(EASDFN,.EAINFO)
+14 ; print page 1
+15 DO PAGE1^EASEC101(.EALNE,.EAINFO,EASDFN)
+16 ; print pages 2 and 3
+17 IF $GET(EAINFO("FORM"))
Begin DoDot:1
+18 ; new 10-10EC format (LTC Phase IV - EAS*1*40)
+19 DO PAGE2^EASEC10R(.EALNE,.EAINFO,EASDFN)
+20 DO PAGE3^EASEC10R(.EALNE,.EAINFO,EASDFN)
End DoDot:1
GOTO ENQUIT
+21 IF '$TEST
Begin DoDot:1
+22 ; old 10-10EC format
+23 DO PAGE2^EASEC102(.EALNE,.EAINFO,EASDFN)
+24 DO PAGE3^EASEC103(.EALNE,.EAINFO,EASDFN)
End DoDot:1
+25 ;
ENQUIT ; cleanup temp globals after printing has completed
+1 KILL ^TMP("1010EC",$JOB,EASDFN)
+2 QUIT
+3 ;
SETUP(EALNE,EAINFO,EASDFN) ;setup print variables
+1 ; Input:
+2 ; EALNE - Line format array
+3 ; EAINFO - Misc data array
+4 ; ("CLRK") - Clerk's Initials
+5 ; ("PGE") - Page number
+6 ; ("PD") - Print Date
+7 ; ("VET") - Veteran's Name
+8 ; ("SSN") - Veteran's SSN
+9 ; ("MTDT") - Long Term Care Test date
+10 ; ("DGMTIEN") - ien of LTC Test in 408.31
+11 ; EASDFN - DFN of applicant in the Patient file (#2)
+12 ;
+13 NEW X,SSN
+14 ;
+15 ;Build Line array for printout
+16 SET EALNE("ULC")=$SELECT('($DATA(IOST)#2):"-",IOST["C-":"-",1:"_")
+17 SET EALNE("D")=""
SET EALNE("DD")=""
SET EALNE("UL")=""
+18 SET $PIECE(EALNE("D"),"-",131)=""
SET $PIECE(EALNE("DD"),"=",131)=""
SET $PIECE(EALNE("UL"),EALNE("ULC"),131)=""
+19 SET EAINFO("L")="W !,EALNE(""UL"")"
+20 if EALNE("ULC")'="-"
SET EAINFO("L")=$TRANSLATE(EAINFO("L"),"!,")
+21 ;
+22 ;Get clerk's initials
+23 SET ZUSR=$GET(ZUSR)
+24 if $GET(ZUSR)=""
SET ZUSR=$GET(DUZ)
+25 IF +ZUSR>0
Begin DoDot:1
+26 SET EAINFO("CLRK")=$$GET1^DIQ(200,ZUSR,1)
+27 IF EAINFO("CLRK")']""
Begin DoDot:2
+28 SET X=$$GET1^DIQ(200,ZUSR,.01)
+29 SET EAINFO("CLRK")=$EXTRACT($PIECE(X,",",2),1)_$EXTRACT($PIECE(X,","),1)
End DoDot:2
End DoDot:1
+30 IF '$TEST
Begin DoDot:1
+31 SET EAINFO("CLRK")="unk"
End DoDot:1
+32 ;
+33 ;Get LTC Test date (if it is not passed, use latest LTC test date)
+34 IF $GET(EAINFO("DGMTIEN"))
SET EAINFO("MTDT")=$$GET1^DIQ(408.31,EAINFO("DGMTIEN"),.01,"I")
+35 ;
IF '$TEST
Begin DoDot:1
+36 NEW MTDTNEG
+37 SET MTDTNEG=+$ORDER(^DGMT(408.31,"AID",3,EASDFN,""))
+38 SET EAINFO("MTDT")=$TRANSLATE(MTDTNEG,"-")
+39 SET EAINFO("DGMTIEN")=$ORDER(^DGMT(408.31,"AID",3,EASDFN,MTDTNEG,""))
End DoDot:1
+40 ;
+41 ;Set data elements
+42 SET EAINFO("PGE")=0
+43 SET EAINFO("PD")=$$FMTE^XLFDT($$NOW^XLFDT)
+44 SET EAINFO("VET")=$$GET1^DIQ(2,EASDFN_",",.01)
+45 SET SSN=$$GET1^DIQ(2,EASDFN_",",.09)
+46 SET EAINFO("SSN")=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+47 ;Line added to set new variable to indicate which version of the
+48 ;10-10EC form is to be printed. LTC Phase IV (EAS*1*40)
+49 SET EAINFO("FORM")=$$FORM^EASECU(EAINFO("DGMTIEN"))
+50 QUIT
+51 ;
HDRMAIN(EALNE) ;
+1 WRITE @IOF
+2 WRITE !,EALNE("DD")
+3 WRITE !,"D E P A R T M E N T O F V E T E R A N S A F F A I R S",?90,"APPLICATION FOR EXTENDED CARE SERVICES",!,EALNE("DD")
+4 WRITE !?50,"SECTION I - GENERAL INFORMATION",!,EALNE("D")
+5 QUIT
+6 ;
HDR(EALNE,EAINFO) ;
+1 WRITE @IOF
+2 WRITE EALNE("DD")
+3 WRITE !,"APPLICATION FOR EXTENDED CARE SERVICES, Continued"
+4 WRITE ?65,"| Veteran's Name",?100,"| Social Security Number"
+5 WRITE !?65,"| ",EAINFO("VET"),?100,"| ",EAINFO("SSN")
+6 WRITE !,EALNE("DD")
+7 QUIT
+8 ;
FT(EALNE,EAINFO) ;
+1 NEW %,Y
+2 WRITE !,EALNE("DD")
+3 ;Modified date printed on form if new 10-10EC format.
+4 ;Added for LTC Phase IV (EAS*1*40).
+5 WRITE !,"VA FORM 10-10EC DEC "_$SELECT(EAINFO("FORM"):"2002",1:"2000"),?40,"PRINTED: ",EAINFO("PD")
+6 WRITE ?80,"Clerk: ",EAINFO("CLRK")
+7 SET EAINFO("PGE")=EAINFO("PGE")+1
+8 WRITE ?120,"Page ",EAINFO("PGE"),?131,$CHAR(13)
+9 QUIT
