source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASMTL6A.m@ 861

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1EASMTL6A ; 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 ;
4LETTER(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 ;
86GETPAT(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 ;
111CHKADR(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 ;
126DEFSIG ; 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 ;;
Note: See TracBrowser for help on using the repository browser.