1 | EASMTL6A ; MIN/TCM ALB/SCK/PHH - AUTOMATED MEANS TEST LETTER-PRINT LETTERS CONT ; 3/10/03 4:07pm
|
---|
2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,28,54**;MAR 15,2001
|
---|
3 | ;
|
---|
4 | LETTER(EASN,TYPE) ;Print letter
|
---|
5 | ; Input
|
---|
6 | ; EASN - File #713.2 IEN
|
---|
7 | ; TYPE - Letter type
|
---|
8 | ;
|
---|
9 | N DFN,EASADD,EASIN,EASNME,EALNE,EASFAC,MSG,TAB,EAFIEN,EAX,LINE,EASANV,EASX,VADM,VAROOT,OFFSET,EASPTR,EASLIEN,EASITE,EASRTE,EASDEM,POP
|
---|
10 | ;
|
---|
11 | S TAB=3 ; Tab spacing for letters
|
---|
12 | S OFFSET=+$$GET1^DIQ(713,1,10) ; Get print offset for address
|
---|
13 | ;
|
---|
14 | ; Get patient data for letter
|
---|
15 | S EASPTR=$$GET1^DIQ(713.2,EASN,2,"I")
|
---|
16 | I EASPTR]"" S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
|
---|
17 | E S DFN=-1
|
---|
18 | ; Get patient mailing information
|
---|
19 | D GETPAT(DFN,.EASDEM,.EASADD)
|
---|
20 | ; Get return address info
|
---|
21 | D GETFAC^EASMTL6(DFN,.EASFAC)
|
---|
22 | ;
|
---|
23 | W @IOF
|
---|
24 | I EASFAC(100)]"" D
|
---|
25 | . W !!?TAB+OFFSET,EASFAC(100)
|
---|
26 | E D
|
---|
27 | . W !!?TAB+OFFSET,"VA MEDICAL CENTER"
|
---|
28 | W ?(IOM-10),$E(EASDEM(1),1,1),EASDEM(2)
|
---|
29 | ;
|
---|
30 | W !?TAB+OFFSET,EASFAC(1.01)
|
---|
31 | I EASFAC(1.02)]"" W !?TAB+OFFSET,EASFAC(1.02)
|
---|
32 | W !?TAB+OFFSET,EASFAC(1.03)_" "_$P(EASFAC(.02),U,2)_" "_EASFAC(1.04)
|
---|
33 | W !!!?TAB+OFFSET,$$FMTE^XLFDT(DT,1)
|
---|
34 | ;
|
---|
35 | ;; generic test letter setup
|
---|
36 | I DFN>0 D
|
---|
37 | . S EASNME("FILE")=2,EASNME("IENS")=DFN,EASNME("FIELD")=.01
|
---|
38 | . W !!!!?TAB+OFFSET,$$NAMEFMT^XLFNAME(.EASNME,"G")
|
---|
39 | E D
|
---|
40 | . W !!!!?TAB+OFFSET,EASDEM(1)
|
---|
41 | ;;
|
---|
42 | W !?TAB+OFFSET,EASADD(1)
|
---|
43 | ;
|
---|
44 | I EASADD(2)]"" W !?TAB+OFFSET,EASADD(2)
|
---|
45 | W !?TAB+OFFSET,EASADD(4)
|
---|
46 | I +EASADD(5) W " ",$$GET1^DIQ(5,$P(EASADD(5),U),1)
|
---|
47 | W " ",$P(EASADD(11),U,2)
|
---|
48 | ;
|
---|
49 | S EASANV=$$GET1^DIQ(713.2,EASN,3,"I")
|
---|
50 | W !!!!,?TAB,"MEANS TEST ANNIVERSARY DATE: ",$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV))
|
---|
51 | ;
|
---|
52 | S EASX=$P(EASDEM(5),U)
|
---|
53 | ;; Patch 15
|
---|
54 | W !!,?TAB,"Dear ",$S(EASX="M":"Mr. ",EASX="F":"Ms. ",1:"Mr./Ms. ")
|
---|
55 | W $S(DFN>0:$$NAMEFMT^XLFNAME(.EASNME,"O","M"),1:"TEST"),":"
|
---|
56 | ;;
|
---|
57 | ; Print letter body
|
---|
58 | S EASLIEN=$O(^EAS(713.3,"C",TYPE,0))
|
---|
59 | Q:'EASLIEN
|
---|
60 | S EALNE=0
|
---|
61 | ;
|
---|
62 | W !
|
---|
63 | F S EALNE=$O(^EAS(713.3,EASLIEN,1,EALNE)) Q:'EALNE D
|
---|
64 | . S LINE=^EAS(713.3,EASLIEN,1,EALNE,0)
|
---|
65 | . I LINE["|ANNVDT|" W !?TAB,$P(LINE,"|ANNVDT|",1),$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV)),$P(LINE,"|ANNVDT|",2) Q
|
---|
66 | . W !?TAB,LINE
|
---|
67 | ;
|
---|
68 | ; Retrieve division section of letter
|
---|
69 | S EAFIEN=$O(^EAS(713.3,EASLIEN,2,"B",+EASFAC("FACNUM"),0))
|
---|
70 | ;
|
---|
71 | I 'EAFIEN D ; Print default signature block
|
---|
72 | . N EAX,LINE
|
---|
73 | . F EAX=1:1:9 D
|
---|
74 | . . S LINE=$P($T(DEFSIG+EAX),";;",2)
|
---|
75 | . . I LINE["|FAC|" W !?TAB,$P(LINE,"|FAC|",1),$S(EASFAC(100)]"":EASFAC(100),1:"VA Medical Center"),$P(LINE,"|FAC|",2) Q
|
---|
76 | . . W !?TAB,LINE
|
---|
77 | ;
|
---|
78 | I EAFIEN D ; Print division/facility signature block
|
---|
79 | . S EALNE=0
|
---|
80 | . F S EALNE=$O(^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE)) Q:'EALNE D
|
---|
81 | . . W !?TAB,^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE,0)
|
---|
82 | ;
|
---|
83 | W !!?TAB,"Enclosure"
|
---|
84 | Q
|
---|
85 | ;
|
---|
86 | GETPAT(DFN,EASDEM,EASADD) ; Get patient information
|
---|
87 | N VAROOT,VA
|
---|
88 | ;
|
---|
89 | ;; Patch 15, Generic test letter
|
---|
90 | I DFN<0 D Q
|
---|
91 | . S EASDEM(1)="TEST LETTER (DO NOT MAIL!)"
|
---|
92 | . S EASDEM(2)="6789"
|
---|
93 | . S EASDEM(5)="M"
|
---|
94 | . S EASADD(1)="THIS IS A TEST LETTER STREET ADDRESS"
|
---|
95 | . S EASADD(2)=""
|
---|
96 | . S EASADD(4)="ANYTOWN"
|
---|
97 | . S EASADD(5)="36^NEW YORK"
|
---|
98 | . S EASADD(11)="111110000^11111-0000"
|
---|
99 | ;; End patch 15
|
---|
100 | ;
|
---|
101 | S VAROOT="EASADD"
|
---|
102 | D ADD^VADPT
|
---|
103 | ;
|
---|
104 | S VAROOT="EASDEM"
|
---|
105 | D DEM^VADPT
|
---|
106 | ;
|
---|
107 | D PID^VADPT6
|
---|
108 | S EASDEM(2)=VA("BID")
|
---|
109 | Q
|
---|
110 | ;
|
---|
111 | CHKADR(EASPTR) ; Check for valid address
|
---|
112 | N EASADD,RSLT,DFN,VAROOT
|
---|
113 | ;
|
---|
114 | S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
|
---|
115 | S RSLT=1
|
---|
116 | S VAROOT="EASADD"
|
---|
117 | D ADD^VADPT
|
---|
118 | ;; Check for valid mailing address
|
---|
119 | I EASADD(1)]"",EASADD(4)]"",EASADD(5)]"",EASADD(11)]"" S RSLT=0
|
---|
120 | ;; Check for Bad Address Indicator
|
---|
121 | S EASADD("BAI")=$$BADADR^DGUTL3(DFN),$P(EASADD("BAI"),U,2)=$$EXTERNAL^DILFD(2,.121,"",+EASADD("BAI"))
|
---|
122 | S:'RSLT&(EASADD("BAI")) RSLT=1
|
---|
123 | D:RSLT ADRERR^EASMTUTL(.EASADD,DFN)
|
---|
124 | Q $G(RSLT)
|
---|
125 | ;
|
---|
126 | DEFSIG ; Default closing and signature block
|
---|
127 | ;;Thank you for your assistance and cooperation. If you have any
|
---|
128 | ;;questions or need assistance in the completion of the information
|
---|
129 | ;;requested, please contact the |FAC| Business
|
---|
130 | ;;Office between 8:00am and 4:00pm Monday through Friday.
|
---|
131 | ;;
|
---|
132 | ;;Sincerely,
|
---|
133 | ;;
|
---|
134 | ;;
|
---|
135 | ;;
|
---|