| 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 |  ;;
 | 
|---|