source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZP6U.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.8 KB
RevLine 
[613]1EASEZP6U ;ALB/AMA - Print utility for 10-10EZ, Version 6 or greater; 10/23/00
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**51,60,57**;Mar 15, 2001
3 ;
4 Q
5 ;Parts of this routine were copied from EASEZPU (the other parts are
6 ;in EASEZPU2); if the version # of the 1010EZ application is 6.0 or
7 ;greater, then this routine will be executed.
8 ;
9PAGE1 ;This function retrieves and formats the page 1 application data from
10 ;the 1010EZ Holding File, #712, for the printed version of the VistA
11 ;10-10EZ form. If the holding file entry has not been accepted, and
12 ;a vista entry is available, the vista entry is printed.
13 ; Called from EN^EASEZP6F
14 ;
15 ;The ^TMP("EZTEMP") global is built in SETUP^EASEZP6F and
16 ;remains until the printed form is complete.
17 ; Variables
18 ; ZDATA - references TMP global for output data
19 ; EZDATA - references available data from 1010EZ holding file
20 ; EASTR - Temporary String data variable
21 ; EAX,EAY - Temporary data variables
22 ; EACT - Temporary city variable
23 ;
24 N ZDATA,EZDATA,EASTR,EAX,EAY,EACT
25 ;
26 S ZDATA=$NA(^TMP("EASEZ",$J,1))
27 S EZDATA=$NA(^TMP("EZTEMP",$J,"I",1))
28 K @ZDATA
29 ;
30 ;Type Of Benefits Applied For
31 S EASTR="" F EAX="1A.1","1A.2","1A.3","1A.4","1A.5" D
32 . I $$PROCESS(EAX)="UNKNOWN" S EASTR="UNKNOWN, ",EAX="1A.5" Q
33 . I $$PROCESS(EAX)="YES" S EASTR=EASTR_$$BENEFIT(EAX)_", "
34 S @ZDATA@("1A")=$E(EASTR,1,($L(EASTR)-2)) ;remove last comma & space
35 ;
36 S @ZDATA@("1B")=$$PROCESS("1B.") ;Which facility?
37 S @ZDATA@(2)=$$PROCESS(2.1) ;Vet's name
38 S @ZDATA@(3)=$E($$PROCESS("3."),1,35) ;Other names used
39 S EAX=$E($$PROCESS("3A."),1,35) ;Mother's maiden name
40 I $E(EAX,$L(EAX))="," S EAX=$E(EAX,1,$L(EAX)-1)
41 S @ZDATA@("3A")=EAX
42 S @ZDATA@(4)=$$PROCESS("4.") ;Gender
43 ;
44 S EAX=$$PROCESS("4A.") ;Are You Spanish, Hispanic, or Latino?
45 ;EAS*1.0*57 - print full word "UNKNOWN"
46 S @ZDATA@("4A")=$S($E(EAX)="Y"!($E(EAX,1,3)="YES"):"YES",$E(EAX)="N"!($E(EAX,1,3)="NO"):"NO",$E(EAX,1,7)="UNKNOWN":"UNKNOWN",1:"")
47 ;
48 F EAX="4B","4C","4D","4E","4F","4G" D ;Race
49 . I $E($$PROCESS(EAX_"."),1,3)="YES" S @ZDATA@(EAX)=" X " I 1
50 . E S @ZDATA@(EAX)="___"
51 ;
52 S @ZDATA@(5)=$$PROCESS("5.") ;SSN
53 S @ZDATA@(6)=$$PROCESS("6.") ;Claim number
54 S @ZDATA@(7)=$$PROCESS("7.") ;Date of birth
55 S @ZDATA@(8)=$$PROCESS("8.") ;Religion
56 S EAX=$$PROCESS("8A."),EAY=$$PROCESS("8B.") ;Birth place city & state
57 I (EAX]""),(EAY]"") S @ZDATA@("8A")=EAX_", "_EAY
58 E S @ZDATA@("8A")=$S(EAX]"":EAX,EAY]"":EAY,1:"")
59 S @ZDATA@("9A")=$E($$PROCESS("9A."),1,35) ;Address
60 S @ZDATA@("9B")=$E($$PROCESS("9B."),1,32) ;City
61 S @ZDATA@("9C")=$$PROCESS("9C.") ;State
62 S @ZDATA@("9D")=$$PROCESS("9D.") ;Zip
63 S @ZDATA@("9E")=$$PROCESS("9E.") ;County
64 S @ZDATA@(10)=$$PROCESS("10.1") ;Home phone
65 S @ZDATA@(11)=$$PROCESS("11.1") ;Work phone
66 S @ZDATA@("11A")=$$PROCESS("11A.") ;E-mail
67 S @ZDATA@("11B")=$$PROCESS("11B.") ;Want an appt?
68 S @ZDATA@("11C")=$$PROCESS("11C.") ;Been seen before?
69 S @ZDATA@("11D")=$$PROCESS("11D.") ;Location seen before
70 ;
71 ;EAS*1.0*60 -- add cell phone and pager
72 S @ZDATA@("11G")=$$PROCESS("11A1.") ;Cell phone number
73 S @ZDATA@("11H")=$$PROCESS("11A3.") ;Pager number
74 ;
75 S @ZDATA@(12)=$$PROCESS("12.") ;Marital status
76 S @ZDATA@("13A")=$$PROCESS("13A.") ;Last branch of service
77 S @ZDATA@("13B")=$$PROCESS("13B.") ;Last entry date
78 S @ZDATA@("13C")=$$PROCESS("13C.") ;Last discharge date
79 S @ZDATA@("13D")=$$PROCESS("13D.") ;Discharge type
80 S @ZDATA@("13E")=$$PROCESS("13E.") ;Military service number
81 ;
82 F EAX="14A1","14A2","14B","14B2","14D3","14D4","14E","14F","14G","14G1","14I","14J","14K","14L" D
83 . S EAY=$$PROCESS(EAX_".")
84 . ;EAS*1.0*57 - no room on form here to print full word "UNKNOWN"
85 . S @ZDATA@(EAX)=$S(EAY="Y"!(EAY="YES"):"YES",EAY="N"!(EAY="NO"):"NO",EAY="UNKNOWN":"UNK",1:"")
86 ;
87 S @ZDATA@("14B1")=$$PROCESS("14B1.") ;Rated percentage
88 S @ZDATA@("14K1")=$$PROCESS("14K1.") ;Medicare Part A effective date
89 S @ZDATA@("14L1")=$$PROCESS("14L1.") ;Medicare Part B effective date
90 S @ZDATA@("14M")=$$PROCESS("14M.") ;Medicare claim number
91 S @ZDATA@("14N")=$$PROCESS("14N.") ;Name on Medicare card
92 ;Vet's employment status^Date of retirement
93 S @ZDATA@("15A")=$$PROCESS("15A.1")_U_$$PROCESS("15A.2")
94 ;
95 S EAX=$E($$PROCESS("15B.1"),1,30) ;Company's name
96 S EACT="",EACT=$E($$PROCESS("15B.3"),1,30) ;Company's city
97 I EACT]"" S EACT=EACT_", " ;if there's a city, add comma & space
98 ;Company's name^Street^City, State Zip^Phone
99 S EAX=EAX_U_$E($$PROCESS("15B.2"),1,30)_U_EACT_$$PROCESS("15B.4")_" "_$E($$PROCESS("15B.5"),1,10)_U_$$PROCESS("15B.6")
100 S @ZDATA@("15B")=EAX
101 ;
102 ;Spouse's employment status^Date of retirement
103 S @ZDATA@("16A")=$$PROCESS("16A.1")_U_$$PROCESS("16A.2")
104 ;
105 S EAX=$E($$PROCESS("16B.1"),1,30) ;Spouse's company's name
106 S EACT="",EACT=$E($$PROCESS("16B.3"),1,30) ;Spouse's company's city
107 I EACT]"" S EACT=EACT_", " ;if there's a city, add comma & space
108 ;Spouse's company's name^Street^City, State Zip^Phone
109 S EAX=EAX_U_$E($$PROCESS("16B.2"),1,30)_U_EACT_$$PROCESS("16B.4")_" "_$E($$PROCESS("16B.5"),1,10)_U_$$PROCESS("16B.6")
110 S @ZDATA@("16B")=EAX
111 ;
112 Q
113 ;
114PROCESS(KEY) ; Process data value from ^TMP("EZTEMP" array
115 ;format = IEN ^ EAS DATA ^ ACCEPT VALUE ^ 712 SUBIEN ^ VISTA DATA
116 ;Take #712 value from 2nd piece, if it's accepted;
117 ;otherwise, take the Patient File value from the 5th piece
118 ;
119 N EAV,RSLT
120 ;
121 I '$D(@EZDATA@(KEY)) G PQ
122 S EAV=@EZDATA@(KEY)
123 S RSLT=$S(+$P(EAV,U,3):$P(EAV,U,2),1:$P(EAV,U,5))
124PQ Q $G(RSLT)
125 ;
126BENEFIT(X) ; Return External format of benefit applied for
127 ;
128 Q $S(X="1A.1":"HEALTH SERVICES",X="1A.2":"NURSING HOME",X="1A.3":"DOMICILIARY",X="1A.4":"DENTAL",X="1A.5":"ENROLLMENT",1:"")
Note: See TracBrowser for help on using the repository browser.