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 Apr 09, 2024@20:59:55 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 ;;
