Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EASMTL6A

EASMTL6A.m

Go to the documentation of this file.
  1. EASMTL6A ; MIN/TCM ALB/SCK/PHH,ERC - AUTOMATED MEANS TEST LETTER-PRINT LETTERS CONT ; 10/23/07 4:45pm
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,28,54,70,81**;MAR 15,2001;Build 11
  1. ;
  1. LETTER(EASN,TYPE) ;Print letter
  1. ; Input
  1. ; EASN - File #713.2 IEN
  1. ; TYPE - Letter type
  1. ;
  1. N DFN,EASADD,EASIN,EASNME,EALNE,EASFAC,MSG,TAB,EAFIEN,EAX,LINE,EASANV,EASX,VADM,VAROOT,OFFSET,EASPTR,EASLIEN,EASITE,EASRTE,EASDEM,POP
  1. ;
  1. S TAB=3 ; Tab spacing for letters
  1. S OFFSET=+$$GET1^DIQ(713,1,10) ; Get print offset for address
  1. ;
  1. ; Get patient data for letter
  1. S EASPTR=$$GET1^DIQ(713.2,EASN,2,"I")
  1. I EASPTR]"" S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
  1. E S DFN=-1
  1. ; Get patient mailing information
  1. D GETPAT(DFN,.EASDEM,.EASADD)
  1. ; Get return address info
  1. D GETFAC^EASMTL6(DFN,.EASFAC)
  1. ;
  1. W @IOF
  1. I EASFAC(100)]"" D
  1. . W !!?TAB+OFFSET,EASFAC(100)
  1. E D
  1. . W !!?TAB+OFFSET,"VA MEDICAL CENTER"
  1. W ?(IOM-10),$E(EASDEM(1),1,1),EASDEM(2)
  1. ;
  1. W !?TAB+OFFSET,EASFAC(1.01)
  1. I EASFAC(1.02)]"" W !?TAB+OFFSET,EASFAC(1.02)
  1. W !?TAB+OFFSET,EASFAC(1.03)_" "_$P(EASFAC(.02),U,2)_" "_EASFAC(1.04)
  1. W !!!?TAB+OFFSET,$$FMTE^XLFDT(DT,1)
  1. ;
  1. ;; generic test letter setup
  1. I DFN>0 D
  1. . S EASNME("FILE")=2,EASNME("IENS")=DFN,EASNME("FIELD")=.01
  1. . W !!!!?TAB+OFFSET,$$NAMEFMT^XLFNAME(.EASNME,"G")
  1. E D
  1. . W !!!!?TAB+OFFSET,EASDEM(1)
  1. ;;
  1. ;;adding foreign address changes for DG*5.3*688 - ERC
  1. N DGFOR
  1. S DGFOR=0
  1. I EASADD(25)]"",($P(EASADD(25),U,2)'["UNITED STATES") S DGFOR=1
  1. W !?TAB+OFFSET,EASADD(1)
  1. ;
  1. I EASADD(2)]"" W !?TAB+OFFSET,EASADD(2)
  1. ;for domestic address display city/zip
  1. I 'DGFOR D
  1. . W !?TAB+OFFSET,EASADD(4)
  1. . I +EASADD(5) W $S(EASADD(4)]"":",",1:"")_$$GET1^DIQ(5,$P(EASADD(5),U),1)
  1. . W " ",$P(EASADD(11),U,2)
  1. ;for foreign address display province/postal
  1. I DGFOR D
  1. . W !
  1. . I EASADD(24)]"" W ?TAB+OFFSET,EASADD(24)_" "_EASADD(4)_" "_EASADD(23)
  1. . I EASADD(24)']"" W ?TAB+OFFSET,EASADD(4)_$S(EASADD(4):" "_EASADD(23),1:EASADD(23))
  1. . ;display country for foreign address only
  1. . I EASADD(25)]"" D
  1. . . S EASCNTRY=$P(EASADD(25),U,2)
  1. . . I EASCNTRY=-1 S EASCNTRY="UNKNOWN COUNTRY"
  1. . . W !?TAB+OFFSET,EASCNTRY
  1. ;
  1. S EASANV=$$GET1^DIQ(713.2,EASN,3,"I")
  1. W !!!!,?TAB,"MEANS TEST ANNIVERSARY DATE: ",$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV))
  1. ;
  1. S EASX=$P(EASDEM(5),U)
  1. ;; Patch 15
  1. W !!,?TAB,"Dear ",$S(EASX="M":"Mr. ",EASX="F":"Ms. ",1:"Mr./Ms. ")
  1. W $S(DFN>0:$$NAMEFMT^XLFNAME(.EASNME,"O","M"),1:"TEST"),":"
  1. ;;
  1. ; Print letter body
  1. S EASLIEN=$O(^EAS(713.3,"C",TYPE,0))
  1. Q:'EASLIEN
  1. S EALNE=0
  1. ;
  1. W !
  1. F S EALNE=$O(^EAS(713.3,EASLIEN,1,EALNE)) Q:'EALNE D
  1. . S LINE=^EAS(713.3,EASLIEN,1,EALNE,0)
  1. . I LINE["|ANNVDT|" W !?TAB,$P(LINE,"|ANNVDT|",1),$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV)),$P(LINE,"|ANNVDT|",2) Q
  1. . W !?TAB,LINE
  1. ;
  1. ; Retrieve division section of letter
  1. S EAFIEN=$O(^EAS(713.3,EASLIEN,2,"B",+EASFAC("FACNUM"),0))
  1. ;
  1. I 'EAFIEN D ; Print default signature block
  1. . N EAX,LINE
  1. . F EAX=1:1:9 D
  1. . . S LINE=$P($T(DEFSIG+EAX),";;",2)
  1. . . I LINE["|FAC|" W !?TAB,$P(LINE,"|FAC|",1),$S(EASFAC(100)]"":EASFAC(100),1:"VA Medical Center"),$P(LINE,"|FAC|",2) Q
  1. . . W !?TAB,LINE
  1. ;
  1. I EAFIEN D ; Print division/facility signature block
  1. . S EALNE=0
  1. . F S EALNE=$O(^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE)) Q:'EALNE D
  1. . . W !?TAB,^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE,0)
  1. ;
  1. W !!?TAB,$S($G(TYPE)=1:"Enclosure",1:"")
  1. Q
  1. ;
  1. GETPAT(DFN,EASDEM,EASADD) ; Get patient information
  1. N VAROOT,VA
  1. ;
  1. ;; Patch 15, Generic test letter
  1. I DFN<0 D Q
  1. . S EASDEM(1)="TEST LETTER (DO NOT MAIL!)"
  1. . S EASDEM(2)="6789"
  1. . S EASDEM(5)="M"
  1. . S EASADD(1)="THIS IS A TEST LETTER STREET ADDRESS"
  1. . S EASADD(2)=""
  1. . S EASADD(4)="ANYTOWN"
  1. . S EASADD(5)="36^NEW YORK"
  1. . S EASADD(11)="111110000^11111-0000"
  1. . S EASADD(25)="1^UNITED STATES"
  1. ;; End patch 15
  1. ;
  1. S VAROOT="EASADD"
  1. D ADD^VADPT
  1. ;
  1. S VAROOT="EASDEM"
  1. D DEM^VADPT
  1. ;
  1. D PID^VADPT6
  1. S EASDEM(2)=VA("BID")
  1. Q
  1. ;
  1. CHKADR(EASPTR) ; Check for valid address
  1. N EASADD,RSLT,DFN,VAROOT
  1. ;
  1. S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
  1. S RSLT=1
  1. S VAROOT="EASADD"
  1. D ADD^VADPT
  1. ;; Check for valid mailing address
  1. I $P(EASADD(25),U,2)']""!($P(EASADD(25),U,2)["UNITED STATES") D
  1. . I EASADD(1)]"",EASADD(4)]"",EASADD(5)]"",EASADD(11)]"" S RSLT=0
  1. I $P(EASADD(25),U,2)]""!($P(EASADD(25),U,2)'["UNITED STATES") D
  1. . I EASADD(1)]"",EASADD(4)]"" S RSLT=0
  1. ;; Check for Bad Address Indicator
  1. S EASADD("BAI")=$$BADADR^DGUTL3(DFN),$P(EASADD("BAI"),U,2)=$$EXTERNAL^DILFD(2,.121,"",+EASADD("BAI"))
  1. S:'RSLT&(EASADD("BAI")) RSLT=1
  1. D:RSLT ADRERR^EASMTUTL(.EASADD,DFN)
  1. Q $G(RSLT)
  1. ;
  1. DEFSIG ; Default closing and signature block
  1. ;;Thank you for your assistance and cooperation. If you have any
  1. ;;questions or need assistance in the completion of the information
  1. ;;requested, please contact the |FAC| Business
  1. ;;Office between 8:00am and 4:00pm Monday through Friday.
  1. ;;
  1. ;;Sincerely,
  1. ;;
  1. ;;
  1. ;;