EASMTL6 ; ALB/SCK,BRM,LBD,PHH - AUTOMATED MEANS TEST LETTER-INTERACTIVE PRINT ; 5/22/03 9:52am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,25,22,54**;MAR 15,2001
;
EN ; Main entry point
; Input, set in option call, if not passed in, or called interactively, user is asked to specify.
; EATYP - Used for selective printing of letters and forms
; 1 : 60-Day
; 2 : 30-Day
; 4 : 0-Day
;
N DIR,DIRUT,POP,EASLOC,Y
;
;; Select type of letter to print
I '$G(EATYP) D Q:$D(DIRUT)
. S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
. S DIR("?")="Select the type of letter to print"
. D ^DIR K DIR
. S EATYP=+Y
;
;; Select facility filter if appropriate
S EASLOC=-1
I $$GET1^DIQ(713,1,8,"I") D Q:$D(DIRUT)
. S DIR(0)="YAO",DIR("A")="Filter letters by Preferred Facility? "
. S DIR("B")="NO"
. S DIR("?")="Enter 'YES' to limit letters to a specific Facility or 'NO' to print all letters."
. D ^DIR K DIR
. Q:$D(DIRUT)!('Y)
. S EASLOC=$$FACNUM
;
K IOP,IO("Q")
;
S %ZIS="QP",%ZIS("B")=$$GET1^DIQ(713,1,5)
D ^%ZIS K %ZIS
Q:POP
I $D(IO("Q")) D QUE Q
D LTR
D ^%ZISC
K EATYP
Q
;
QUE ; Queue the report
N ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED
;
S ZTRTN="LTR^EASMTL6"
S ZTDESC="EAS MT LETTERS PRINT JOB"
S ZTSAVE("EATYP")="",ZTSAVE("EASLOC")=""
S ZTDTH="NOW"
;
D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Letters canceled!"
E W !!?5,"Letters queued! [ ",ZTSK," ]"
D HOME^%ZIS
Q
;
LTR ; Main entry point
N EASTMP,EASKP
;
S EASTMP="^TMP(""EASMT"",$J)"
K @EASTMP
;
I '$D(ZTQUEUED) W !,"...Gathering letters to print...Please wait"
D BLD(EATYP,EASLOC,EASTMP,.EASKP)
D RESULT(.EASKP,EATYP)
I '$D(ZTQUEUED) W !,"...Printing letters..."
D PRINT(EASTMP,EATYP)
K @EASTMP,EATYP
Q
;
RESULT(EASKP,EATYP) ; Send results of letter printing to mail group
N MSG,XMSUB,XMY,XMTEXT,XMDUZ,TOT,X1
;
S MSG(1)="Letters to print: "_$J($FN(EASKP("CNT"),","),8)
S MSG(2)="Letters where the print date has not reached: "_$J($FN(EASKP("T"),","),8)
S MSG(2.5)=""
S MSG(3)="The following letters were found but not printed for the following reasons:"
S MSG(4)="Incomplete/Bad Addr : "_$J($FN(EASKP("I"),","),8)
S MSG(5)="Deceased : "_$J($FN(EASKP("D"),","),8)
S MSG(6)="MT Changed: "_$J($FN(EASKP("C"),","),8)
S MSG(7)="Prohibit flag set: "_$J($FN(EASKP("P"),","),8)
S MSG(8)="Not a User Enrollee: "_$J($FN(EASKP("U"),","),8)
S MSG(8.5)="Not a User Enrollee of this facility: "_$J($FN(EASKP("O"),","),8)
S MSG(9)=""
S TOT=0 F X1="I","D","C","P","O","T","U","CNT" S TOT=TOT+EASKP(X1)
S MSG(10)="Total Letters Processed: "_$J($FN(TOT,","),8)_" (MT not returned)"
;
S XMSUB=$S(EATYP=1:"60-Day",EATYP=2:"30-Day",1:"0-Day")_" Print Letter Results"
S XMTEXT="MSG("
S XMY("G.EAS MTLETTERS")=""
S XMDUZ="AUTOMATED MT LETTERS"
D ^XMD
Q
;
BLD(EATYP,EASLOC,EASTMP,EASKP) ; Build TMP array of letters to print
N DFN,EASIEN,COUNT,EAX2,EASPTR,EASABRT,EASUE
;
F EAX2="P","D","C","F","T","I","O","U","CNT" S EASKP(EAX2)=0
S COUNT=0
;
S EASIEN=0 ; Begin loop through un-returned means tests
F S EASIEN=$O(^EAS(713.2,"AC",0,EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
. S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I") ; Pointer to File 713.1
. ; begin checks
. Q:EASPTR<0 ; SAFETY CHECK
. Q:$$LTRTYP^EASMTL6B(EASIEN)'=EATYP ; Check for appropriate letter type
. S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I") Q:'DFN
. ;; Filter by site, quit if filter not met
. I +$G(EASLOC)>0 Q:$$GET1^DIQ(2,DFN,27.02,"I")'=+EASLOC
. I $D(^EAS(713.1,"AP",1,EASPTR)) D Q ; Check Prohibit letter
. . D CLRFLG^EASMTUTL(0,EASIEN)
. . S EASKP("P")=EASKP("P")+1
. I $$DECEASED^EASMTUTL(EASIEN) D Q ; Check Deceased
. . D CLRFLG^EASMTUTL(0,EASIEN)
. . S EASKP("D")=EASKP("D")+1
. I $$CHECKMT^EASMTUTL(EASPTR,EASIEN) D Q ; Check MT changed?
. . D CLRFLG^EASMTUTL(0,EASIEN)
. . S EASKP("C")=EASKP("C")+1 Q
. I $$FUTMT^EASMTUTL(EASIEN) D Q ; Check for a Future MT
. . D CLRFLG^EASMTUTL(0,EASIEN)
. . S EASKP("F")=EASKP("F")+1
. I '$$THRSHLD(EATYP,EASIEN) D Q ; Quit if letter threshold not reached
. . S EASKP("T")=EASKP("T")+1
. ; Get User Enrollee status (0=not UE; 1=UE; 2=UE, not this site)
. S EASUE=$$UESTAT^EASUER(DFN)
. I 'EASUE D Q ; Quit if not User Enrollee
. . D NOPRT(EATYP,EASIEN)
. . S EASKP("U")=EASKP("U")+1
. I EASUE'=1 D Q ; Quit if User Enrollee site is not this facility
. . D NOPRT(EATYP,EASIEN)
. . S EASKP("O")=EASKP("O")+1
. I $$CHKADR^EASMTL6A(EASPTR) D Q ; Check for valid address
. . S EASKP("I")=EASKP("I")+1
. S @EASTMP@(EASIEN)=EATYP ; Build entry
. S EASKP("CNT")=EASKP("CNT")+1
. I $D(IO("Q")),$$S^%ZTLOAD("STOPPED BY USER") S EASABRT=1
Q
;
OWNED(PTR1,EAIEN) ; Check - Does this facility "own" this means test
; Returns '1' if means test 'owned' by facility
; '0' if not owned
;
N MTNODE,MTLST,MTOWN,RSLT
;
S RSLT=0
S MTLST=$$LST^DGMTU(PTR1)
I $P(MTLST,U,1)>0 D
. S MTNODE=$G(^DGMT(408.31,$P(MTLST,U,1),0))
. S MTOWN=$$GET1^DIQ(408.34,$P(MTNODE,U,23),.01)
. I MTOWN="VAMC" S RSLT=1 Q
. I MTOWN="DCD",$$VERSION^XPDUTL("IVMC") S RSLT=1
;
;; If another facility 'owns' this MT, update MT Status information
I 'RSLT D
. Q:'EAIEN
. S DIE="^EAS(713.2,",DA=EAIEN
. S DR="4///YES;5///TODAY;7///MT 'OWNED' BY ANOTHER FACILITY;9///NO;12///NO;18///NO"
. D ^DIE K DIE
;
Q RSLT
;
PRINT(EASTMP,EATYP) ; Print letters
N EASIEN,EASABRT,Y
;
U IO
S EASIEN=0
F S EASIEN=$O(@EASTMP@(EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
. D LETTER^EASMTL6A(EASIEN,EATYP) ; Print letter
. D UPDSTAT(EASIEN,EATYP) ; Update Letter status file, #713.2
. I $D(IO("Q")),$$S^%ZTLOAD("STOPPED BY USER") S EASABRT=1 Q
. I '$D(IO("Q")),$E(IOST,1,2)="C-" D
. . S DIR(0)="E"
. . D ^DIR K DIR
. . S:'Y EASABRT=1
Q
;
THRSHLD(EATYP,EASIEN) ; Check threshold for letter types
; Input
; EATYP - Letter type to print
; EASIEN - IEN for file #713.2
;
; Output
; RSLT = 1: Letter is inside threshold to print
; 0: Letter is outside threshold (Don't print)
;
N DIFF,THRESH,RSLT,ANVDT,MTDT
;
S RSLT=1
Q:'$G(EATYP)
S THRESH=$S(EATYP=1:60,EATYP=2:30,1:0)
S MTDT=$$GET1^DIQ(713.2,EASIEN,3,"I")
S ANVDT=$$ADDLEAP^EASMTUTL(MTDT)
S DIFF=$$FMDIFF^XLFDT(ANVDT,$$DT^XLFDT)
I DIFF>THRESH S RSLT=0
Q RSLT
;
NOPRT(EATYP,EASIEN) ; Letter not printed, update Letter Status file #713.2
; Input
; EATYP - Letter type to print
; EASIEN - IEN for file #713.2
;
N DIE,DR,DA,LTR
Q:'$G(EATYP) Q:'$G(EASIEN)
S DIE="^EAS(713.2,",DA=EASIEN
S LTR=$S(EATYP=1:9,EATYP=2:12,EATYP=4:18,1:0)
Q:'LTR
; Set current letter print statuses = "N"
S DR=LTR_"///0;"_(LTR+1)_"///0"
; If current letter is not 0-day letter, set next letter print = "Y"
S:LTR'=18 DR=DR_";"_$S(LTR=9:12,1:18)_"///1"
D ^DIE
Q
;
UPDSTAT(EASN,EAX) ; Update Letter status file, #713.2
N DIE,DR,DA,EAPD,EAFLG,NXTFLG
;
S DIE="^EAS(713.2,",DA=EASN
S DR=$S(EAX=1:10,EAX=2:13,EAX=4:19,1:0)
Q:'DR
S EAPD=DR_".5",EAFLG=DR-1
S DR=DR_"///1;"_EAPD_"///^S X=$$DT^XLFDT;"_EAFLG_"///0"
S NXTFLG=$S(EAFLG=9:12,EAFLG=12:18,1:0)
S:NXTFLG>0 DR=DR_";"_NXTFLG_"///1"
D ^DIE K DIE
D CLRFLG^EASMTUTL(EAX,EASN)
Q
;
FACNUM() ; Get facility number
N RSLT,DIR,Y
;
S DIR(0)="P^4:EMZ"
S DIR("S")="I '$P($G(^DIC(4,Y,99)),U,4)"
D ^DIR K DIR
I $D(DIRUT) S RSLT=0
E S RSLT=+Y_"^"_$P($G(^DIC(4,+Y,99)),U,1)
;
Q RSLT
;
GETFAC(EADFN,EASARY) ; set facility return address information
N EASFAC,EAX,EASF,EAS4
;
I $$GET1^DIQ(713,1,9,"I") D
. S EASFAC=$$GET1^DIQ(2,EADFN,27.02,"I")
. Q:'EASFAC
. ;; Check for inactive flag
. Q:$$GET1^DIQ(4,EASFAC,101,"I")
. D GETS^DIQ(4,EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
. S EASF=EASFAC_","
. ;; Check for valid address information
. I EAS4(4,EASF,1.01,"E")]"",EAS4(4,EASF,1.03,"E")]"",EAS4(4,EASF,.02,"E")]"" S EASARY("TYP")="P"
;
I $G(EASARY("TYP"))'="P" D
. S EASFAC=$$SITE^VASITE
. D GETS^DIQ(4,+EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
. S EASARY("TYP")="F"
;
S EASARY("FACNUM")=+EASFAC
S EASARY("FAC")=$$GET1^DIQ(4,+EASFAC,.01,"I")
F EAX=1.01,1.02,1.03,1.04,100 D
. S EASARY(EAX)=EAS4(4,+EASFAC_",",EAX,"E")
S EASARY(.02)=EAS4(4,+EASFAC_",",.02,"E")_"^"_$$GET1^DIQ(5,EAS4(4,+EASFAC_",",.02,"I"),1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASMTL6 8526 printed Apr 09, 2024@20:58:47 Page 2
EASMTL6 ; ALB/SCK,BRM,LBD,PHH - AUTOMATED MEANS TEST LETTER-INTERACTIVE PRINT ; 5/22/03 9:52am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,14,15,29,25,22,54**;MAR 15,2001
+2 ;
EN ; Main entry point
+1 ; Input, set in option call, if not passed in, or called interactively, user is asked to specify.
+2 ; EATYP - Used for selective printing of letters and forms
+3 ; 1 : 60-Day
+4 ; 2 : 30-Day
+5 ; 4 : 0-Day
+6 ;
+7 NEW DIR,DIRUT,POP,EASLOC,Y
+8 ;
+9 ;; Select type of letter to print
+10 IF '$GET(EATYP)
Begin DoDot:1
+11 SET DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
+12 SET DIR("?")="Select the type of letter to print"
+13 DO ^DIR
KILL DIR
+14 SET EATYP=+Y
End DoDot:1
if $DATA(DIRUT)
QUIT
+15 ;
+16 ;; Select facility filter if appropriate
+17 SET EASLOC=-1
+18 IF $$GET1^DIQ(713,1,8,"I")
Begin DoDot:1
+19 SET DIR(0)="YAO"
SET DIR("A")="Filter letters by Preferred Facility? "
+20 SET DIR("B")="NO"
+21 SET DIR("?")="Enter 'YES' to limit letters to a specific Facility or 'NO' to print all letters."
+22 DO ^DIR
KILL DIR
+23 if $DATA(DIRUT)!('Y)
QUIT
+24 SET EASLOC=$$FACNUM
End DoDot:1
if $DATA(DIRUT)
QUIT
+25 ;
+26 KILL IOP,IO("Q")
+27 ;
+28 SET %ZIS="QP"
SET %ZIS("B")=$$GET1^DIQ(713,1,5)
+29 DO ^%ZIS
KILL %ZIS
+30 if POP
QUIT
+31 IF $DATA(IO("Q"))
DO QUE
QUIT
+32 DO LTR
+33 DO ^%ZISC
+34 KILL EATYP
+35 QUIT
+36 ;
QUE ; Queue the report
+1 NEW ZTRTN,ZTDESC,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED
+2 ;
+3 SET ZTRTN="LTR^EASMTL6"
+4 SET ZTDESC="EAS MT LETTERS PRINT JOB"
+5 SET ZTSAVE("EATYP")=""
SET ZTSAVE("EASLOC")=""
+6 SET ZTDTH="NOW"
+7 ;
+8 DO ^%ZTLOAD
+9 IF $DATA(ZTSK)[0
WRITE !!?5,"Letters canceled!"
+10 IF '$TEST
WRITE !!?5,"Letters queued! [ ",ZTSK," ]"
+11 DO HOME^%ZIS
+12 QUIT
+13 ;
LTR ; Main entry point
+1 NEW EASTMP,EASKP
+2 ;
+3 SET EASTMP="^TMP(""EASMT"",$J)"
+4 KILL @EASTMP
+5 ;
+6 IF '$DATA(ZTQUEUED)
WRITE !,"...Gathering letters to print...Please wait"
+7 DO BLD(EATYP,EASLOC,EASTMP,.EASKP)
+8 DO RESULT(.EASKP,EATYP)
+9 IF '$DATA(ZTQUEUED)
WRITE !,"...Printing letters..."
+10 DO PRINT(EASTMP,EATYP)
+11 KILL @EASTMP,EATYP
+12 QUIT
+13 ;
RESULT(EASKP,EATYP) ; Send results of letter printing to mail group
+1 NEW MSG,XMSUB,XMY,XMTEXT,XMDUZ,TOT,X1
+2 ;
+3 SET MSG(1)="Letters to print: "_$JUSTIFY($FNUMBER(EASKP("CNT"),","),8)
+4 SET MSG(2)="Letters where the print date has not reached: "_$JUSTIFY($FNUMBER(EASKP("T"),","),8)
+5 SET MSG(2.5)=""
+6 SET MSG(3)="The following letters were found but not printed for the following reasons:"
+7 SET MSG(4)="Incomplete/Bad Addr : "_$JUSTIFY($FNUMBER(EASKP("I"),","),8)
+8 SET MSG(5)="Deceased : "_$JUSTIFY($FNUMBER(EASKP("D"),","),8)
+9 SET MSG(6)="MT Changed: "_$JUSTIFY($FNUMBER(EASKP("C"),","),8)
+10 SET MSG(7)="Prohibit flag set: "_$JUSTIFY($FNUMBER(EASKP("P"),","),8)
+11 SET MSG(8)="Not a User Enrollee: "_$JUSTIFY($FNUMBER(EASKP("U"),","),8)
+12 SET MSG(8.5)="Not a User Enrollee of this facility: "_$JUSTIFY($FNUMBER(EASKP("O"),","),8)
+13 SET MSG(9)=""
+14 SET TOT=0
FOR X1="I","D","C","P","O","T","U","CNT"
SET TOT=TOT+EASKP(X1)
+15 SET MSG(10)="Total Letters Processed: "_$JUSTIFY($FNUMBER(TOT,","),8)_" (MT not returned)"
+16 ;
+17 SET XMSUB=$SELECT(EATYP=1:"60-Day",EATYP=2:"30-Day",1:"0-Day")_" Print Letter Results"
+18 SET XMTEXT="MSG("
+19 SET XMY("G.EAS MTLETTERS")=""
+20 SET XMDUZ="AUTOMATED MT LETTERS"
+21 DO ^XMD
+22 QUIT
+23 ;
BLD(EATYP,EASLOC,EASTMP,EASKP) ; Build TMP array of letters to print
+1 NEW DFN,EASIEN,COUNT,EAX2,EASPTR,EASABRT,EASUE
+2 ;
+3 FOR EAX2="P","D","C","F","T","I","O","U","CNT"
SET EASKP(EAX2)=0
+4 SET COUNT=0
+5 ;
+6 ; Begin loop through un-returned means tests
SET EASIEN=0
+7 FOR
SET EASIEN=$ORDER(^EAS(713.2,"AC",0,EASIEN))
if 'EASIEN
QUIT
Begin DoDot:1
+8 ; Pointer to File 713.1
SET EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
+9 ; begin checks
+10 ; SAFETY CHECK
if EASPTR<0
QUIT
+11 ; Check for appropriate letter type
if $$LTRTYP^EASMTL6B(EASIEN)'=EATYP
QUIT
+12 SET DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
if 'DFN
QUIT
+13 ;; Filter by site, quit if filter not met
+14 IF +$GET(EASLOC)>0
if $$GET1^DIQ(2,DFN,27.02,"I")'=+EASLOC
QUIT
+15 ; Check Prohibit letter
IF $DATA(^EAS(713.1,"AP",1,EASPTR))
Begin DoDot:2
+16 DO CLRFLG^EASMTUTL(0,EASIEN)
+17 SET EASKP("P")=EASKP("P")+1
End DoDot:2
QUIT
+18 ; Check Deceased
IF $$DECEASED^EASMTUTL(EASIEN)
Begin DoDot:2
+19 DO CLRFLG^EASMTUTL(0,EASIEN)
+20 SET EASKP("D")=EASKP("D")+1
End DoDot:2
QUIT
+21 ; Check MT changed?
IF $$CHECKMT^EASMTUTL(EASPTR,EASIEN)
Begin DoDot:2
+22 DO CLRFLG^EASMTUTL(0,EASIEN)
+23 SET EASKP("C")=EASKP("C")+1
QUIT
End DoDot:2
QUIT
+24 ; Check for a Future MT
IF $$FUTMT^EASMTUTL(EASIEN)
Begin DoDot:2
+25 DO CLRFLG^EASMTUTL(0,EASIEN)
+26 SET EASKP("F")=EASKP("F")+1
End DoDot:2
QUIT
+27 ; Quit if letter threshold not reached
IF '$$THRSHLD(EATYP,EASIEN)
Begin DoDot:2
+28 SET EASKP("T")=EASKP("T")+1
End DoDot:2
QUIT
+29 ; Get User Enrollee status (0=not UE; 1=UE; 2=UE, not this site)
+30 SET EASUE=$$UESTAT^EASUER(DFN)
+31 ; Quit if not User Enrollee
IF 'EASUE
Begin DoDot:2
+32 DO NOPRT(EATYP,EASIEN)
+33 SET EASKP("U")=EASKP("U")+1
End DoDot:2
QUIT
+34 ; Quit if User Enrollee site is not this facility
IF EASUE'=1
Begin DoDot:2
+35 DO NOPRT(EATYP,EASIEN)
+36 SET EASKP("O")=EASKP("O")+1
End DoDot:2
QUIT
+37 ; Check for valid address
IF $$CHKADR^EASMTL6A(EASPTR)
Begin DoDot:2
+38 SET EASKP("I")=EASKP("I")+1
End DoDot:2
QUIT
+39 ; Build entry
SET @EASTMP@(EASIEN)=EATYP
+40 SET EASKP("CNT")=EASKP("CNT")+1
+41 IF $DATA(IO("Q"))
IF $$S^%ZTLOAD("STOPPED BY USER")
SET EASABRT=1
End DoDot:1
if $GET(EASABRT)
QUIT
+42 QUIT
+43 ;
OWNED(PTR1,EAIEN) ; Check - Does this facility "own" this means test
+1 ; Returns '1' if means test 'owned' by facility
+2 ; '0' if not owned
+3 ;
+4 NEW MTNODE,MTLST,MTOWN,RSLT
+5 ;
+6 SET RSLT=0
+7 SET MTLST=$$LST^DGMTU(PTR1)
+8 IF $PIECE(MTLST,U,1)>0
Begin DoDot:1
+9 SET MTNODE=$GET(^DGMT(408.31,$PIECE(MTLST,U,1),0))
+10 SET MTOWN=$$GET1^DIQ(408.34,$PIECE(MTNODE,U,23),.01)
+11 IF MTOWN="VAMC"
SET RSLT=1
QUIT
+12 IF MTOWN="DCD"
IF $$VERSION^XPDUTL("IVMC")
SET RSLT=1
End DoDot:1
+13 ;
+14 ;; If another facility 'owns' this MT, update MT Status information
+15 IF 'RSLT
Begin DoDot:1
+16 if 'EAIEN
QUIT
+17 SET DIE="^EAS(713.2,"
SET DA=EAIEN
+18 SET DR="4///YES;5///TODAY;7///MT 'OWNED' BY ANOTHER FACILITY;9///NO;12///NO;18///NO"
+19 DO ^DIE
KILL DIE
End DoDot:1
+20 ;
+21 QUIT RSLT
+22 ;
PRINT(EASTMP,EATYP) ; Print letters
+1 NEW EASIEN,EASABRT,Y
+2 ;
+3 USE IO
+4 SET EASIEN=0
+5 FOR
SET EASIEN=$ORDER(@EASTMP@(EASIEN))
if 'EASIEN
QUIT
Begin DoDot:1
+6 ; Print letter
DO LETTER^EASMTL6A(EASIEN,EATYP)
+7 ; Update Letter status file, #713.2
DO UPDSTAT(EASIEN,EATYP)
+8 IF $DATA(IO("Q"))
IF $$S^%ZTLOAD("STOPPED BY USER")
SET EASABRT=1
QUIT
+9 IF '$DATA(IO("Q"))
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:2
+10 SET DIR(0)="E"
+11 DO ^DIR
KILL DIR
+12 if 'Y
SET EASABRT=1
End DoDot:2
End DoDot:1
if $GET(EASABRT)
QUIT
+13 QUIT
+14 ;
THRSHLD(EATYP,EASIEN) ; Check threshold for letter types
+1 ; Input
+2 ; EATYP - Letter type to print
+3 ; EASIEN - IEN for file #713.2
+4 ;
+5 ; Output
+6 ; RSLT = 1: Letter is inside threshold to print
+7 ; 0: Letter is outside threshold (Don't print)
+8 ;
+9 NEW DIFF,THRESH,RSLT,ANVDT,MTDT
+10 ;
+11 SET RSLT=1
+12 if '$GET(EATYP)
QUIT
+13 SET THRESH=$SELECT(EATYP=1:60,EATYP=2:30,1:0)
+14 SET MTDT=$$GET1^DIQ(713.2,EASIEN,3,"I")
+15 SET ANVDT=$$ADDLEAP^EASMTUTL(MTDT)
+16 SET DIFF=$$FMDIFF^XLFDT(ANVDT,$$DT^XLFDT)
+17 IF DIFF>THRESH
SET RSLT=0
+18 QUIT RSLT
+19 ;
NOPRT(EATYP,EASIEN) ; Letter not printed, update Letter Status file #713.2
+1 ; Input
+2 ; EATYP - Letter type to print
+3 ; EASIEN - IEN for file #713.2
+4 ;
+5 NEW DIE,DR,DA,LTR
+6 if '$GET(EATYP)
QUIT
if '$GET(EASIEN)
QUIT
+7 SET DIE="^EAS(713.2,"
SET DA=EASIEN
+8 SET LTR=$SELECT(EATYP=1:9,EATYP=2:12,EATYP=4:18,1:0)
+9 if 'LTR
QUIT
+10 ; Set current letter print statuses = "N"
+11 SET DR=LTR_"///0;"_(LTR+1)_"///0"
+12 ; If current letter is not 0-day letter, set next letter print = "Y"
+13 if LTR'=18
SET DR=DR_";"_$SELECT(LTR=9:12,1:18)_"///1"
+14 DO ^DIE
+15 QUIT
+16 ;
UPDSTAT(EASN,EAX) ; Update Letter status file, #713.2
+1 NEW DIE,DR,DA,EAPD,EAFLG,NXTFLG
+2 ;
+3 SET DIE="^EAS(713.2,"
SET DA=EASN
+4 SET DR=$SELECT(EAX=1:10,EAX=2:13,EAX=4:19,1:0)
+5 if 'DR
QUIT
+6 SET EAPD=DR_".5"
SET EAFLG=DR-1
+7 SET DR=DR_"///1;"_EAPD_"///^S X=$$DT^XLFDT;"_EAFLG_"///0"
+8 SET NXTFLG=$SELECT(EAFLG=9:12,EAFLG=12:18,1:0)
+9 if NXTFLG>0
SET DR=DR_";"_NXTFLG_"///1"
+10 DO ^DIE
KILL DIE
+11 DO CLRFLG^EASMTUTL(EAX,EASN)
+12 QUIT
+13 ;
FACNUM() ; Get facility number
+1 NEW RSLT,DIR,Y
+2 ;
+3 SET DIR(0)="P^4:EMZ"
+4 SET DIR("S")="I '$P($G(^DIC(4,Y,99)),U,4)"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
SET RSLT=0
+7 IF '$TEST
SET RSLT=+Y_"^"_$PIECE($GET(^DIC(4,+Y,99)),U,1)
+8 ;
+9 QUIT RSLT
+10 ;
GETFAC(EADFN,EASARY) ; set facility return address information
+1 NEW EASFAC,EAX,EASF,EAS4
+2 ;
+3 IF $$GET1^DIQ(713,1,9,"I")
Begin DoDot:1
+4 SET EASFAC=$$GET1^DIQ(2,EADFN,27.02,"I")
+5 if 'EASFAC
QUIT
+6 ;; Check for inactive flag
+7 if $$GET1^DIQ(4,EASFAC,101,"I")
QUIT
+8 DO GETS^DIQ(4,EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
+9 SET EASF=EASFAC_","
+10 ;; Check for valid address information
+11 IF EAS4(4,EASF,1.01,"E")]""
IF EAS4(4,EASF,1.03,"E")]""
IF EAS4(4,EASF,.02,"E")]""
SET EASARY("TYP")="P"
End DoDot:1
+12 ;
+13 IF $GET(EASARY("TYP"))'="P"
Begin DoDot:1
+14 SET EASFAC=$$SITE^VASITE
+15 DO GETS^DIQ(4,+EASFAC,".01;1.01;1.02;1.03;1.04;.02;100","EI","EAS4")
+16 SET EASARY("TYP")="F"
End DoDot:1
+17 ;
+18 SET EASARY("FACNUM")=+EASFAC
+19 SET EASARY("FAC")=$$GET1^DIQ(4,+EASFAC,.01,"I")
+20 FOR EAX=1.01,1.02,1.03,1.04,100
Begin DoDot:1
+21 SET EASARY(EAX)=EAS4(4,+EASFAC_",",EAX,"E")
End DoDot:1
+22 SET EASARY(.02)=EAS4(4,+EASFAC_",",.02,"E")_"^"_$$GET1^DIQ(5,EAS4(4,+EASFAC_",",.02,"I"),1)
+23 QUIT
