- EASMTL6A ; MIN/TCM ALB/SCK/PHH,ERC - AUTOMATED MEANS TEST LETTER-PRINT LETTERS CONT ; 10/23/07 4:45pm
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,28,54,70,81**;MAR 15,2001;Build 11
- ;
- LETTER(EASN,TYPE) ;Print letter
- ; Input
- ; EASN - File #713.2 IEN
- ; TYPE - Letter type
- ;
- N DFN,EASADD,EASIN,EASNME,EALNE,EASFAC,MSG,TAB,EAFIEN,EAX,LINE,EASANV,EASX,VADM,VAROOT,OFFSET,EASPTR,EASLIEN,EASITE,EASRTE,EASDEM,POP
- ;
- S TAB=3 ; Tab spacing for letters
- S OFFSET=+$$GET1^DIQ(713,1,10) ; Get print offset for address
- ;
- ; Get patient data for letter
- S EASPTR=$$GET1^DIQ(713.2,EASN,2,"I")
- I EASPTR]"" S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
- E S DFN=-1
- ; Get patient mailing information
- D GETPAT(DFN,.EASDEM,.EASADD)
- ; Get return address info
- D GETFAC^EASMTL6(DFN,.EASFAC)
- ;
- W @IOF
- I EASFAC(100)]"" D
- . W !!?TAB+OFFSET,EASFAC(100)
- E D
- . W !!?TAB+OFFSET,"VA MEDICAL CENTER"
- W ?(IOM-10),$E(EASDEM(1),1,1),EASDEM(2)
- ;
- W !?TAB+OFFSET,EASFAC(1.01)
- I EASFAC(1.02)]"" W !?TAB+OFFSET,EASFAC(1.02)
- W !?TAB+OFFSET,EASFAC(1.03)_" "_$P(EASFAC(.02),U,2)_" "_EASFAC(1.04)
- W !!!?TAB+OFFSET,$$FMTE^XLFDT(DT,1)
- ;
- ;; generic test letter setup
- I DFN>0 D
- . S EASNME("FILE")=2,EASNME("IENS")=DFN,EASNME("FIELD")=.01
- . W !!!!?TAB+OFFSET,$$NAMEFMT^XLFNAME(.EASNME,"G")
- E D
- . W !!!!?TAB+OFFSET,EASDEM(1)
- ;;
- ;;adding foreign address changes for DG*5.3*688 - ERC
- N DGFOR
- S DGFOR=0
- I EASADD(25)]"",($P(EASADD(25),U,2)'["UNITED STATES") S DGFOR=1
- W !?TAB+OFFSET,EASADD(1)
- ;
- I EASADD(2)]"" W !?TAB+OFFSET,EASADD(2)
- ;for domestic address display city/zip
- I 'DGFOR D
- . W !?TAB+OFFSET,EASADD(4)
- . I +EASADD(5) W $S(EASADD(4)]"":",",1:"")_$$GET1^DIQ(5,$P(EASADD(5),U),1)
- . W " ",$P(EASADD(11),U,2)
- ;for foreign address display province/postal
- I DGFOR D
- . W !
- . I EASADD(24)]"" W ?TAB+OFFSET,EASADD(24)_" "_EASADD(4)_" "_EASADD(23)
- . I EASADD(24)']"" W ?TAB+OFFSET,EASADD(4)_$S(EASADD(4):" "_EASADD(23),1:EASADD(23))
- . ;display country for foreign address only
- . I EASADD(25)]"" D
- . . S EASCNTRY=$P(EASADD(25),U,2)
- . . I EASCNTRY=-1 S EASCNTRY="UNKNOWN COUNTRY"
- . . W !?TAB+OFFSET,EASCNTRY
- ;
- S EASANV=$$GET1^DIQ(713.2,EASN,3,"I")
- W !!!!,?TAB,"MEANS TEST ANNIVERSARY DATE: ",$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV))
- ;
- S EASX=$P(EASDEM(5),U)
- ;; Patch 15
- W !!,?TAB,"Dear ",$S(EASX="M":"Mr. ",EASX="F":"Ms. ",1:"Mr./Ms. ")
- W $S(DFN>0:$$NAMEFMT^XLFNAME(.EASNME,"O","M"),1:"TEST"),":"
- ;;
- ; Print letter body
- S EASLIEN=$O(^EAS(713.3,"C",TYPE,0))
- Q:'EASLIEN
- S EALNE=0
- ;
- W !
- F S EALNE=$O(^EAS(713.3,EASLIEN,1,EALNE)) Q:'EALNE D
- . S LINE=^EAS(713.3,EASLIEN,1,EALNE,0)
- . I LINE["|ANNVDT|" W !?TAB,$P(LINE,"|ANNVDT|",1),$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV)),$P(LINE,"|ANNVDT|",2) Q
- . W !?TAB,LINE
- ;
- ; Retrieve division section of letter
- S EAFIEN=$O(^EAS(713.3,EASLIEN,2,"B",+EASFAC("FACNUM"),0))
- ;
- I 'EAFIEN D ; Print default signature block
- . N EAX,LINE
- . F EAX=1:1:9 D
- . . S LINE=$P($T(DEFSIG+EAX),";;",2)
- . . I LINE["|FAC|" W !?TAB,$P(LINE,"|FAC|",1),$S(EASFAC(100)]"":EASFAC(100),1:"VA Medical Center"),$P(LINE,"|FAC|",2) Q
- . . W !?TAB,LINE
- ;
- I EAFIEN D ; Print division/facility signature block
- . S EALNE=0
- . F S EALNE=$O(^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE)) Q:'EALNE D
- . . W !?TAB,^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE,0)
- ;
- W !!?TAB,$S($G(TYPE)=1:"Enclosure",1:"")
- Q
- ;
- GETPAT(DFN,EASDEM,EASADD) ; Get patient information
- N VAROOT,VA
- ;
- ;; Patch 15, Generic test letter
- I DFN<0 D Q
- . S EASDEM(1)="TEST LETTER (DO NOT MAIL!)"
- . S EASDEM(2)="6789"
- . S EASDEM(5)="M"
- . S EASADD(1)="THIS IS A TEST LETTER STREET ADDRESS"
- . S EASADD(2)=""
- . S EASADD(4)="ANYTOWN"
- . S EASADD(5)="36^NEW YORK"
- . S EASADD(11)="111110000^11111-0000"
- . S EASADD(25)="1^UNITED STATES"
- ;; End patch 15
- ;
- S VAROOT="EASADD"
- D ADD^VADPT
- ;
- S VAROOT="EASDEM"
- D DEM^VADPT
- ;
- D PID^VADPT6
- S EASDEM(2)=VA("BID")
- Q
- ;
- CHKADR(EASPTR) ; Check for valid address
- N EASADD,RSLT,DFN,VAROOT
- ;
- S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
- S RSLT=1
- S VAROOT="EASADD"
- D ADD^VADPT
- ;; Check for valid mailing address
- I $P(EASADD(25),U,2)']""!($P(EASADD(25),U,2)["UNITED STATES") D
- . I EASADD(1)]"",EASADD(4)]"",EASADD(5)]"",EASADD(11)]"" S RSLT=0
- I $P(EASADD(25),U,2)]""!($P(EASADD(25),U,2)'["UNITED STATES") D
- . I EASADD(1)]"",EASADD(4)]"" S RSLT=0
- ;; Check for Bad Address Indicator
- S EASADD("BAI")=$$BADADR^DGUTL3(DFN),$P(EASADD("BAI"),U,2)=$$EXTERNAL^DILFD(2,.121,"",+EASADD("BAI"))
- S:'RSLT&(EASADD("BAI")) RSLT=1
- D:RSLT ADRERR^EASMTUTL(.EASADD,DFN)
- Q $G(RSLT)
- ;
- DEFSIG ; Default closing and signature block
- ;;Thank you for your assistance and cooperation. If you have any
- ;;questions or need assistance in the completion of the information
- ;;requested, please contact the |FAC| Business
- ;;Office between 8:00am and 4:00pm Monday through Friday.
- ;;
- ;;Sincerely,
- ;;
- ;;
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASMTL6A 4999 printed Feb 18, 2025@23:21:51 Page 2
- 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
- +2 ;
- LETTER(EASN,TYPE) ;Print letter
- +1 ; Input
- +2 ; EASN - File #713.2 IEN
- +3 ; TYPE - Letter type
- +4 ;
- +5 NEW DFN,EASADD,EASIN,EASNME,EALNE,EASFAC,MSG,TAB,EAFIEN,EAX,LINE,EASANV,EASX,VADM,VAROOT,OFFSET,EASPTR,EASLIEN,EASITE,EASRTE,EASDEM,POP
- +6 ;
- +7 ; Tab spacing for letters
- SET TAB=3
- +8 ; Get print offset for address
- SET OFFSET=+$$GET1^DIQ(713,1,10)
- +9 ;
- +10 ; Get patient data for letter
- +11 SET EASPTR=$$GET1^DIQ(713.2,EASN,2,"I")
- +12 IF EASPTR]""
- SET DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
- +13 IF '$TEST
- SET DFN=-1
- +14 ; Get patient mailing information
- +15 DO GETPAT(DFN,.EASDEM,.EASADD)
- +16 ; Get return address info
- +17 DO GETFAC^EASMTL6(DFN,.EASFAC)
- +18 ;
- +19 WRITE @IOF
- +20 IF EASFAC(100)]""
- Begin DoDot:1
- +21 WRITE !!?TAB+OFFSET,EASFAC(100)
- End DoDot:1
- +22 IF '$TEST
- Begin DoDot:1
- +23 WRITE !!?TAB+OFFSET,"VA MEDICAL CENTER"
- End DoDot:1
- +24 WRITE ?(IOM-10),$EXTRACT(EASDEM(1),1,1),EASDEM(2)
- +25 ;
- +26 WRITE !?TAB+OFFSET,EASFAC(1.01)
- +27 IF EASFAC(1.02)]""
- WRITE !?TAB+OFFSET,EASFAC(1.02)
- +28 WRITE !?TAB+OFFSET,EASFAC(1.03)_" "_$PIECE(EASFAC(.02),U,2)_" "_EASFAC(1.04)
- +29 WRITE !!!?TAB+OFFSET,$$FMTE^XLFDT(DT,1)
- +30 ;
- +31 ;; generic test letter setup
- +32 IF DFN>0
- Begin DoDot:1
- +33 SET EASNME("FILE")=2
- SET EASNME("IENS")=DFN
- SET EASNME("FIELD")=.01
- +34 WRITE !!!!?TAB+OFFSET,$$NAMEFMT^XLFNAME(.EASNME,"G")
- End DoDot:1
- +35 IF '$TEST
- Begin DoDot:1
- +36 WRITE !!!!?TAB+OFFSET,EASDEM(1)
- End DoDot:1
- +37 ;;
- +38 ;;adding foreign address changes for DG*5.3*688 - ERC
- +39 NEW DGFOR
- +40 SET DGFOR=0
- +41 IF EASADD(25)]""
- IF ($PIECE(EASADD(25),U,2)'["UNITED STATES")
- SET DGFOR=1
- +42 WRITE !?TAB+OFFSET,EASADD(1)
- +43 ;
- +44 IF EASADD(2)]""
- WRITE !?TAB+OFFSET,EASADD(2)
- +45 ;for domestic address display city/zip
- +46 IF 'DGFOR
- Begin DoDot:1
- +47 WRITE !?TAB+OFFSET,EASADD(4)
- +48 IF +EASADD(5)
- WRITE $SELECT(EASADD(4)]"":",",1:"")_$$GET1^DIQ(5,$PIECE(EASADD(5),U),1)
- +49 WRITE " ",$PIECE(EASADD(11),U,2)
- End DoDot:1
- +50 ;for foreign address display province/postal
- +51 IF DGFOR
- Begin DoDot:1
- +52 WRITE !
- +53 IF EASADD(24)]""
- WRITE ?TAB+OFFSET,EASADD(24)_" "_EASADD(4)_" "_EASADD(23)
- +54 IF EASADD(24)']""
- WRITE ?TAB+OFFSET,EASADD(4)_$SELECT(EASADD(4):" "_EASADD(23),1:EASADD(23))
- +55 ;display country for foreign address only
- +56 IF EASADD(25)]""
- Begin DoDot:2
- +57 SET EASCNTRY=$PIECE(EASADD(25),U,2)
- +58 IF EASCNTRY=-1
- SET EASCNTRY="UNKNOWN COUNTRY"
- +59 WRITE !?TAB+OFFSET,EASCNTRY
- End DoDot:2
- End DoDot:1
- +60 ;
- +61 SET EASANV=$$GET1^DIQ(713.2,EASN,3,"I")
- +62 WRITE !!!!,?TAB,"MEANS TEST ANNIVERSARY DATE: ",$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV))
- +63 ;
- +64 SET EASX=$PIECE(EASDEM(5),U)
- +65 ;; Patch 15
- +66 WRITE !!,?TAB,"Dear ",$SELECT(EASX="M":"Mr. ",EASX="F":"Ms. ",1:"Mr./Ms. ")
- +67 WRITE $SELECT(DFN>0:$$NAMEFMT^XLFNAME(.EASNME,"O","M"),1:"TEST"),":"
- +68 ;;
- +69 ; Print letter body
- +70 SET EASLIEN=$ORDER(^EAS(713.3,"C",TYPE,0))
- +71 if 'EASLIEN
- QUIT
- +72 SET EALNE=0
- +73 ;
- +74 WRITE !
- +75 FOR
- SET EALNE=$ORDER(^EAS(713.3,EASLIEN,1,EALNE))
- if 'EALNE
- QUIT
- Begin DoDot:1
- +76 SET LINE=^EAS(713.3,EASLIEN,1,EALNE,0)
- +77 IF LINE["|ANNVDT|"
- WRITE !?TAB,$PIECE(LINE,"|ANNVDT|",1),$$FMTE^XLFDT($$ADDLEAP^EASMTUTL(EASANV)),$PIECE(LINE,"|ANNVDT|",2)
- QUIT
- +78 WRITE !?TAB,LINE
- End DoDot:1
- +79 ;
- +80 ; Retrieve division section of letter
- +81 SET EAFIEN=$ORDER(^EAS(713.3,EASLIEN,2,"B",+EASFAC("FACNUM"),0))
- +82 ;
- +83 ; Print default signature block
- IF 'EAFIEN
- Begin DoDot:1
- +84 NEW EAX,LINE
- +85 FOR EAX=1:1:9
- Begin DoDot:2
- +86 SET LINE=$PIECE($TEXT(DEFSIG+EAX),";;",2)
- +87 IF LINE["|FAC|"
- WRITE !?TAB,$PIECE(LINE,"|FAC|",1),$SELECT(EASFAC(100)]"":EASFAC(100),1:"VA Medical Center"),$PIECE(LINE,"|FAC|",2)
- QUIT
- +88 WRITE !?TAB,LINE
- End DoDot:2
- End DoDot:1
- +89 ;
- +90 ; Print division/facility signature block
- IF EAFIEN
- Begin DoDot:1
- +91 SET EALNE=0
- +92 FOR
- SET EALNE=$ORDER(^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE))
- if 'EALNE
- QUIT
- Begin DoDot:2
- +93 WRITE !?TAB,^EAS(713.3,EASLIEN,2,EAFIEN,1,EALNE,0)
- End DoDot:2
- End DoDot:1
- +94 ;
- +95 WRITE !!?TAB,$SELECT($GET(TYPE)=1:"Enclosure",1:"")
- +96 QUIT
- +97 ;
- GETPAT(DFN,EASDEM,EASADD) ; Get patient information
- +1 NEW VAROOT,VA
- +2 ;
- +3 ;; Patch 15, Generic test letter
- +4 IF DFN<0
- Begin DoDot:1
- +5 SET EASDEM(1)="TEST LETTER (DO NOT MAIL!)"
- +6 SET EASDEM(2)="6789"
- +7 SET EASDEM(5)="M"
- +8 SET EASADD(1)="THIS IS A TEST LETTER STREET ADDRESS"
- +9 SET EASADD(2)=""
- +10 SET EASADD(4)="ANYTOWN"
- +11 SET EASADD(5)="36^NEW YORK"
- +12 SET EASADD(11)="111110000^11111-0000"
- +13 SET EASADD(25)="1^UNITED STATES"
- End DoDot:1
- QUIT
- +14 ;; End patch 15
- +15 ;
- +16 SET VAROOT="EASADD"
- +17 DO ADD^VADPT
- +18 ;
- +19 SET VAROOT="EASDEM"
- +20 DO DEM^VADPT
- +21 ;
- +22 DO PID^VADPT6
- +23 SET EASDEM(2)=VA("BID")
- +24 QUIT
- +25 ;
- CHKADR(EASPTR) ; Check for valid address
- +1 NEW EASADD,RSLT,DFN,VAROOT
- +2 ;
- +3 SET DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
- +4 SET RSLT=1
- +5 SET VAROOT="EASADD"
- +6 DO ADD^VADPT
- +7 ;; Check for valid mailing address
- +8 IF $PIECE(EASADD(25),U,2)']""!($PIECE(EASADD(25),U,2)["UNITED STATES")
- Begin DoDot:1
- +9 IF EASADD(1)]""
- IF EASADD(4)]""
- IF EASADD(5)]""
- IF EASADD(11)]""
- SET RSLT=0
- End DoDot:1
- +10 IF $PIECE(EASADD(25),U,2)]""!($PIECE(EASADD(25),U,2)'["UNITED STATES")
- Begin DoDot:1
- +11 IF EASADD(1)]""
- IF EASADD(4)]""
- SET RSLT=0
- End DoDot:1
- +12 ;; Check for Bad Address Indicator
- +13 SET EASADD("BAI")=$$BADADR^DGUTL3(DFN)
- SET $PIECE(EASADD("BAI"),U,2)=$$EXTERNAL^DILFD(2,.121,"",+EASADD("BAI"))
- +14 if 'RSLT&(EASADD("BAI"))
- SET RSLT=1
- +15 if RSLT
- DO ADRERR^EASMTUTL(.EASADD,DFN)
- +16 QUIT $GET(RSLT)
- +17 ;
- DEFSIG ; Default closing and signature block
- +1 ;;Thank you for your assistance and cooperation. If you have any
- +2 ;;questions or need assistance in the completion of the information
- +3 ;;requested, please contact the |FAC| Business
- +4 ;;Office between 8:00am and 4:00pm Monday through Friday.
- +5 ;;
- +6 ;;Sincerely,
- +7 ;;
- +8 ;;
- +9 ;;