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

EASMTL6.m

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