269 lines
8.7 KiB
Mathematica
269 lines
8.7 KiB
Mathematica
EASEZPDG ;ALB/AMA/GTS/CMF - PRINT 10-10EZ OR EZR FROM DG OPTIONS
|
|
;;1.0;ENROLLMENT APPLICATION SYSTEM;**57**;Mar 15, 2001
|
|
;
|
|
Q
|
|
;
|
|
ENEZR(EASDFN,EASMTIEN) ;DBIA 4600 - PRINT THE 10-10EZR FROM DG OPTIONS
|
|
; INPUT:
|
|
; EASDFN - POINTER TO THE PATIENT FILE (#2) - required
|
|
; EASMTIEN - POINTER TO MEANS TEST FILE (#408.31) - optional
|
|
; (+ien, "", or 0)
|
|
; OUTPUT:
|
|
; (+ien or ""):ZTSK - TASKMAN JOB NUMBER
|
|
; (0):mt ien (forces test lookup only)
|
|
;
|
|
N EASFLAG,X
|
|
S EASFLAG="EZR"
|
|
S EASDFN=$G(EASDFN)
|
|
S EASMTIEN=$G(EASMTIEN)
|
|
;
|
|
S X=$$ENEZ(EASDFN,EASMTIEN)
|
|
Q X
|
|
;
|
|
ENEZ(EASDFN,EASMTIEN) ;DBIA 4600 - PRINT THE 10-10EZ FROM DG OPTIONS
|
|
; INPUT:
|
|
; EASDFN - POINTER TO THE PATIENT FILE (#2) - required
|
|
; EASMTIEN - POINTER TO MEANS TEST FILE (#408.31) - optional
|
|
; (+ien, "", or 0)
|
|
; OUTPUT:
|
|
; (+ien or ""):ZTSK - TASKMAN JOB NUMBER
|
|
; (0):mt ien (forces test lookup only)
|
|
;
|
|
S EASDFN=$G(EASDFN)
|
|
S EASMTIEN=$G(EASMTIEN)
|
|
I EASMTIEN=0 Q $$PICK^EASEZPVU(EASDFN,0)
|
|
E S EASMTIEN=$$PICK^EASEZPVU(EASDFN,EASMTIEN)
|
|
;
|
|
;If any EAS applications exist, ensure they're all filed
|
|
N X,INPROG
|
|
S X=0,INPROG=0 F S X=$O(^EAS(712,"AC",EASDFN,X)) Q:'X!INPROG D
|
|
. I $$GET1^DIQ(712,X,7.1)="" D
|
|
. . N IX,DATE F IX="REV","PRT","SIG" Q:INPROG D
|
|
. . . S DATE=0 F S DATE=$O(^EAS(712,IX,DATE)) Q:'DATE!INPROG D
|
|
. . . . I $D(^EAS(712,IX,DATE,X)) S INPROG=1
|
|
I INPROG D Q 0
|
|
. N DIR
|
|
. W !!,"No data have been found for the selected patient, or"
|
|
. W !,"the patient may have an on-line 10-10EZ application"
|
|
. W !,"in progress. The 10-10EZ"_$S($G(EASFLAG)="EZR":"R",1:"")_" form shall not be printed."
|
|
. S DIR(0)="E" D ^DIR
|
|
;
|
|
N %ZIS,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,ERR
|
|
;
|
|
W !!?5,*7,"Do not select a slave device for output."
|
|
W !?5,"This output requires a 132 column output printer."
|
|
W !?5,"Output to SCREEN will be unreadable.",!
|
|
;
|
|
;
|
|
DEV S %ZIS="QM"
|
|
S %ZIS("S")="I $P($G(^(1)),U)'[""SLAVE""&($P($G(^(0)),U)'[""SLAVE"")"
|
|
S %ZIS("B")=""
|
|
;S IOP="Q"
|
|
D ^%ZIS
|
|
;
|
|
I POP D G EXIT
|
|
. I $D(IO("Q")) K IO("Q")
|
|
. W !,"Print request cancelled!"
|
|
. Q
|
|
I IO=IO(0),$E(IOST,1,2)="C-" D G DEV
|
|
. W !,*7,"CANNOT QUEUE TO HOME DEVICE!",!
|
|
. Q
|
|
;
|
|
I $G(EASFLAG)="EZR" S ZTDESC="1010EZR PRINT"
|
|
E S ZTDESC="1010EZ PRINT"
|
|
S ZUSR=DUZ,ZTRTN="EN^EASEZPDG"
|
|
;
|
|
F X="ZUSR","EASDFN","EASMTIEN","EASFLAG" S ZTSAVE(X)=""
|
|
D ^%ZTLOAD
|
|
D HOME^%ZIS
|
|
;
|
|
EXIT Q +$G(ZTSK)
|
|
;
|
|
EN ;BACKGROUND JOB ENTRY POINT TO PRINT EZ/EZR FROM DG OPTIONS
|
|
;
|
|
N EASAPP,C2711
|
|
S EASAPP=0
|
|
I '$G(EASVRSN) S EASVRSN=6
|
|
;
|
|
;SET UP ^TMP("EZDATA" AND ^TMP("EZINDEX" FROM ^EAS(711,"A","A"
|
|
D LOCAL711^EASEZU2
|
|
;
|
|
S C2711=+$$KEY711^EASEZU1("TYPE OF BENEFIT-ENROLLMENT")
|
|
D VISTA^EASEZPVD(EASDFN,EASMTIEN)
|
|
;
|
|
;SET UP ^TMP("EZTEMP" AND ^TMP("EZDISP" GLOBALS
|
|
D SORT^EASEZC3(0)
|
|
;
|
|
;SET UP PRINT VARIABLES
|
|
N EALNE,EAINFO,EAABRT,EAADL,EAMULT,EAAD,EACNT,KEY
|
|
D SETUP^EASEZPDU(.EALNE,.EAINFO)
|
|
;
|
|
;DETERMINE WHICH FORM TO PRINT
|
|
I $G(EASFLAG)="EZR" D EZR I 1
|
|
E D EZ
|
|
;
|
|
K ^TMP("EASEZ",$J),^TMP("EASEZR",$J)
|
|
K ^TMP("EZDATA",$J),^TMP("EZRDATA",$J)
|
|
K ^TMP("EZINDEX",$J),^TMP("EZRINDEX",$J)
|
|
K ^TMP("EZTEMP",$J),^TMP("EZRTEMP",$J)
|
|
K ^TMP("EZDISP",$J),^TMP("EZRDISP",$J)
|
|
Q
|
|
;
|
|
EZR ; Entry point to print 1010EZR
|
|
;
|
|
N EASDG,EAADL,EAAD,EACNT
|
|
M ^TMP("EASEZR",$J)=^TMP("EASEZ",$J) K ^TMP("EASEZ",$J)
|
|
M ^TMP("EZRDATA",$J)=^TMP("EZDATA",$J) K ^TMP("EZDATA",$J)
|
|
M ^TMP("EZRINDEX",$J)=^TMP("EZINDEX",$J) K ^TMP("EZINDEX",$J)
|
|
M ^TMP("EZRTEMP",$J)=^TMP("EZTEMP",$J) K ^TMP("EZTEMP",$J)
|
|
M ^TMP("EZRDISP",$J)=^TMP("EZDISP",$J) K ^TMP("EZDISP",$J)
|
|
;
|
|
D PAGE1^EASEZRPU
|
|
D EN^EASEZRP1(.EALNE,.EAINFO)
|
|
;
|
|
D PAGE2^EASEZRPP
|
|
S EASDG=1 ;FLAG VARIABLE TO SIGNIFY PRINTING FROM DG
|
|
D EN^EASEZRP2(.EALNE,.EAINFO,EASDG)
|
|
;
|
|
D NETEZR^EASEZPDU(.EALNE,.EAINFO)
|
|
;
|
|
;Print additional insurance pages if more than 1 insurance company
|
|
F EAADL=1:1 Q:'$D(^TMP("EZRTEMP",$J,"IA",EAADL)) D
|
|
. S EAAD=1
|
|
. D PAGEI^EASEZRPU(EAADL)
|
|
I $G(EAAD) D EN^EASEZRPI(.EALNE,.EAINFO)
|
|
;
|
|
;Print additional dependent pages if more than 1 dependent
|
|
S EAAD=0 F EAADL=1:1 Q:'$D(^TMP("EZRTEMP",$J,"IIB",EAADL)) D
|
|
. S EAAD=1 ;FLAG THAT THERE ARE ADDITIONAL DEPENDENTS
|
|
. D PAGEN^EASEZRPU(EAADL)
|
|
I EAAD D EN^EASEZRPD(.EALNE,.EAINFO)
|
|
;
|
|
;;RESORT DEPENDENT SUBSCRIPTS TO ENSURE PROPER NUMERICAL ORDER
|
|
;K ^TMP("EZRSORT",$J)
|
|
;M ^TMP("EZRSORT",$J,"IIF")=^TMP("EZRTEMP",$J,"IIF")
|
|
;K ^TMP("EZRTEMP",$J,"IIF")
|
|
;S EAADL=0,EACNT=1 F S EAADL=$O(^TMP("EZRSORT",$J,"IIF",EAADL)) Q:'EAADL D
|
|
;. N EAQUES
|
|
;. S EACNT=EACNT+1
|
|
;. S EAQUES="" F S EAQUES=$O(^TMP("EZRSORT",$J,"IIF",EAADL,EAQUES)) Q:EAQUES="" D
|
|
;. . S ^TMP("EZRTEMP",$J,"IIF",EACNT,EAQUES)=^TMP("EZRSORT",$J,"IIF",EAADL,EAQUES)
|
|
;K ^TMP("EZRSORT",$J)
|
|
;
|
|
;Print additional dependent financial pages if more
|
|
;than 1 dependent, starting with the 2nd one
|
|
;(since Child 1 info already displayed on pages 2 & 3)
|
|
S EAAD=0,EAADL=1 F S EAADL=$O(^TMP("EZRTEMP",$J,"IIF",EAADL)) Q:'EAADL D
|
|
. S EAAD=1,KEY=+$$KEY711^EASEZU1("CHILD(N) CHILD #")
|
|
. S ^TMP("EZRTEMP",$J,"IIF",EAADL,"7.")=KEY_"^CHILD "_EAADL_"^1"
|
|
. D PAGEDFF^EASEZRPP(EAADL)
|
|
;
|
|
;SINCE ANY ADDITIONAL DEPENDENTS' NET WORTH AMOUNTS (SECTION IIG)
|
|
;ARE INCLUDED IN THE VET'S AMOUNT, DISPLAY A MESSAGE ON THE FORM
|
|
I EAAD D
|
|
. N TEMP,HDR,FTR,BEGF,BEGG,ADFF,FNP,GNP
|
|
. S TEMP="EASEZR",HDR="HDR^EASEZRPF(.EALNE,.EAINFO)"
|
|
. S FTR="FT^EASEZRPF(.EALNE,.EAINFO)",BEGF="BEGINF^EASEZRPM"
|
|
. S BEGG="BEGING^EASEZRPM",ADFF="ADFF^EASEZRPM"
|
|
. S FNP=9,GNP=7
|
|
. D NETMSG
|
|
;
|
|
Q
|
|
;
|
|
EZ ;PRINT THE 10-10EZ FORM (copied from EASEZP6F)
|
|
;
|
|
N EASDG,EAADL,EAAD,EACNT
|
|
D PAGE1^EASEZP6U
|
|
D PAGE1^EASEZPU3
|
|
D EN^EASEZP61(.EALNE,.EAINFO)
|
|
;
|
|
D PAGE2^EASEZPU2
|
|
D EN^EASEZP62(.EALNE,.EAINFO)
|
|
;
|
|
S EASDG=1 ;FLAG VARIABLE TO SIGNIFY PRINTING FROM DG
|
|
D EN^EASEZP63(.EALNE,.EAINFO,EASDG)
|
|
D NETEZ^EASEZPDU(.EALNE,.EAINFO)
|
|
;
|
|
;Print additional insurance pages if more than 1 insurance company
|
|
F EAADL=1:1 Q:'$D(^TMP("EZTEMP",$J,"IA",EAADL)) D
|
|
. S EAAD=1
|
|
. D PAGEI^EASEZPU3(EAADL)
|
|
I $G(EAAD) D EN^EASEZP6I(.EALNE,.EAINFO)
|
|
;
|
|
;Print additional dependent pages if more than 1 dependent
|
|
S EAAD=0 F EAADL=1:1 Q:'$D(^TMP("EZTEMP",$J,"IIB",EAADL)) D
|
|
. S EAAD=1 ;FLAG THAT THERE ARE ADDITIONAL DEPENDENTS
|
|
. D PAGEN^EASEZPU3(EAADL)
|
|
I EAAD D EN^EASEZP6D(.EALNE,.EAINFO)
|
|
;
|
|
K ^AMAB("EASEZ"),^AMAB("EZDATA"),^AMAB("EZINDEX"),^AMAB("EZTEMP"),^AMAB("EZDISP")
|
|
M ^AMAB("EASEZ",$J)=^TMP("EASEZ",$J)
|
|
M ^AMAB("EZDATA",$J)=^TMP("EZDATA",$J)
|
|
M ^AMAB("EZINDEX",$J)=^TMP("EZINDEX",$J)
|
|
M ^AMAB("EZTEMP",$J)=^TMP("EZTEMP",$J)
|
|
M ^AMAB("EZDISP",$J)=^TMP("EZDISP",$J)
|
|
;
|
|
;;RESORT DEPENDENT SUBSCRIPTS TO ENSURE PROPER NUMERICAL ORDER
|
|
;K ^TMP("EZSORT",$J)
|
|
;M ^TMP("EZSORT",$J,"IIF")=^TMP("EZTEMP",$J,"IIF")
|
|
;K ^TMP("EZTEMP",$J,"IIF")
|
|
;S (EAADL,EACNT)=1 F S EAADL=$O(^TMP("EZSORT",$J,"IIF",EAADL)) Q:'EAADL D
|
|
;. N EAQUES
|
|
;. S EACNT=EACNT+1
|
|
;. S EAQUES="" F S EAQUES=$O(^TMP("EZSORT",$J,"IIF",EAADL,EAQUES)) Q:EAQUES="" D
|
|
;. . S ^TMP("EZTEMP",$J,"IIF",EACNT,EAQUES)=^TMP("EZSORT",$J,"IIF",EAADL,EAQUES)
|
|
;K ^TMP("EZSORT",$J)
|
|
;
|
|
;Print additional dependent financial pages if more
|
|
;than 1 dependent, starting with the 2nd one
|
|
;(since Child 1 info already displayed on pages 2 & 3)
|
|
S EAAD=0,EAADL=1 F S EAADL=$O(^TMP("EZTEMP",$J,"IIF",EAADL)) Q:'EAADL D
|
|
. S EAAD=1,KEY=+$$KEY711^EASEZU1("CHILD(N) CHILD #")
|
|
. S ^TMP("EZTEMP",$J,"IIF",EAADL,"7.")=KEY_"^CHILD "_EAADL_"^1"
|
|
. D PAGEDFF^EASEZPU2(EAADL)
|
|
;
|
|
;SINCE ANY ADDITIONAL DEPENDENTS' NET WORTH AMOUNTS (SECTION IIG)
|
|
;ARE INCLUDED IN THE VET'S AMOUNT, DISPLAY A MESSAGE ON THE FORM
|
|
I EAAD D
|
|
. ;PRINT IIF AND IIG SECTIONS
|
|
. N TEMP,HDR,FTR,BEGF,BEGG,ADFF,FNP,GNP
|
|
. S TEMP="EASEZ",HDR="HDR^EASEZP6F(.EALNE,.EAINFO)"
|
|
. S FTR="FT^EASEZP6F(.EALNE,.EAINFO)",BEGF="BEGINF^EASEZP6M"
|
|
. S BEGG="BEGING^EASEZP6M",ADFF="ADFF^EASEZP6M"
|
|
. S FNP=9,GNP=7
|
|
. D NETMSG
|
|
;
|
|
Q
|
|
;
|
|
NETMSG ;PRINT THE MESSAGE FOR THE NET WORTH SECTION
|
|
;
|
|
N EASF,DEPF,DFCNT,NEWPG
|
|
;
|
|
S EASF=$NA(^TMP(TEMP,$J,"DFF"))
|
|
I $O(@EASF@(1)) D @BEGF
|
|
;
|
|
;Start printing with 2nd dependent
|
|
S DEPF=1,DFCNT=0 F S DEPF=$O(@EASF@(DEPF)) Q:'DEPF D
|
|
. S DFCNT=DFCNT+1
|
|
. ;Check to see if a new page is needed
|
|
. I (DFCNT>1),'((DFCNT-1)#FNP) D
|
|
. . D @FTR
|
|
. . D @BEGF
|
|
. I (DFCNT#FNP)'=1 W !?131,$C(13) W:EALNE("ULC")="-" ! W EALNE("UL")
|
|
. D @ADFF
|
|
;
|
|
;PRINT NET WORTH MESSAGE IF THERE ARE *any* ADDITIONAL DEPENDENTS
|
|
I ((DFCNT#FNP)'=0),((DFCNT#FNP)'=GNP) W !!,?131,$C(13) W:EALNE("ULC")="-" ! W EALNE("UL")
|
|
;At the end of IIF, to find when to jump to the next page,
|
|
;55 print lines, minus 3 lines for Section IIG title header,
|
|
;minus the number of lines already used on current page,
|
|
;divided by the number of lines for a Section IIG entry
|
|
S NEWPG=(52-((DFCNT#FNP)*6))\7
|
|
I '(DFCNT#FNP)!'NEWPG!(NEWPG=GNP) S NEWPG=GNP D @FTR
|
|
D @BEGG
|
|
W !!?23,"ANY PREVIOUS CALENDAR YEAR NET WORTH AMOUNTS FROM ANY ADDITIONAL DEPENDENT CHILD(REN)"
|
|
W !!?29,"WILL BE INCLUDED IN THE VETERAN'S PREVIOUS CALENDAR YEAR NET WORTH AMOUNTS.",!
|
|
D @FTR
|
|
;
|
|
Q
|