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

EASMTL10.m

Go to the documentation of this file.
  1. EASMTL10 ;MIN/TCM ALB/SCK,AMA - AUTOMATED MEANS TEST LETTERS - RERUN LETTERS ; 7/17/01
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,15,28,80**;Mar 15, 2001;Build 1
  1. ;
  1. RERUN ; Main entry point to rerun a processing date
  1. N EASDDD,EASLOC,EATYP,XX
  1. ;
  1. D:'$G(IOF) HOME^%ZIS
  1. W @IOF
  1. F XX=1:1:7 W !?2,$P($T(NOTICE+XX),";;",2)
  1. ;
  1. Q:'$$FILTER(.EASLOC) ; Select Filter action, quit on uparrow
  1. Q:'$$LTRTYPE(.EATYP) ; Select type of letter to reprint, quit on uparrow
  1. Q:'$$ASKDT(EATYP,.EASDDD) ; Select date to reprint letters from, quit on uparrow
  1. D QUE1
  1. Q
  1. ;
  1. FILTER(EASLOC) ; Filter by Patient Preferred Location
  1. ; Input: None
  1. ;
  1. ; Output: EASLOC -1 if an error occurred
  1. ; 0 if not filtering by location
  1. ; nnn IEN of filtered facility in the INSTITUTION File
  1. ;
  1. ; RESULT 1 if result of function Ok
  1. ; 0 if user enters "^" or exits
  1. ;
  1. N DIR,DIRUT
  1. ;
  1. S EASLOC=-1
  1. I $$GET1^DIQ(713,1,8,"I") D Q:$D(DIRUT) 0
  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)
  1. . I 'Y S EASLOC=0 Q
  1. . S DIR(0)="P^EAS(713,1,2,:QEM"
  1. . S EASLOC=$$FACNUM^EASMTL6
  1. E D
  1. . S EASLOC=0
  1. Q 1
  1. ;
  1. ASKDT(EATYP,EASDDD) ; Ask for processing date to look for letters
  1. ; Input EATYP Type of letter to be reprinted
  1. ;
  1. ; Output EASDDD Selected processing date for type of letter
  1. ; to be reprinted
  1. ;
  1. ; RESULT 1 if result of function Ok
  1. ; 0 if user enters "^" or exits
  1. ;
  1. N EASDT,RSLT,EAX,EASOFST
  1. ;
  1. S RSLT=0
  1. AGN S EASDT=$$GETDT
  1. G:EASDT<0 ASKQ
  1. ;
  1. S EASOFST=$S(EATYP=2:30,EATYP=4:60,1:0)
  1. S EAX=$$FMADD^XLFDT(EASDT,-EASOFST,0,0,-1)
  1. S EAX=$O(^EAS(713.2,"AD",EAX))
  1. I 'EAX D G AGN
  1. . W !!,"No valid processing date could be found for ",$S(EATYP=2:30,EATYP=4:0,1:60),"-day letters for ",$$FMTE^XLFDT(EASDT),"."
  1. . W !,"Please select another date."
  1. ;
  1. W !!,"To re-print "_$S(EATYP=2:30,EATYP=4:0,1:60)_"-day letters for "_$$FMTE^XLFDT(EASDT)
  1. W !,"the Search/Processing date of "_$$FMTE^XLFDT(EAX)_" will be used."
  1. ;EAS*1.0*80 -- to avoid confusion, changed "ALL" to "all valid"
  1. W !,"Please note: all valid "_$S(EATYP=2:30,EATYP=4:0,1:60)_"-day letters for this processing date will print"
  1. ;
  1. S DIR(0)="YAO"
  1. S DIR("?")="Enter 'YES' to use the "_$$FMTE^XLFDT(EAX)_" date. Enter 'NO' to select a different date."
  1. S DIR("A")="Do you wish to use this date? "
  1. S DIR("B")="YES"
  1. D ^DIR K DIR
  1. I $D(DIRUT) G ASKQ
  1. I 'Y G AGN
  1. ;
  1. S EASDDD=EAX
  1. S RSLT=1
  1. ASKQ Q RSLT
  1. ;
  1. GETDT() ;
  1. N DIR,DIRUT
  1. ;
  1. S DIR(0)="DAO^:DT:EP"
  1. S DIR("?")="Select the date for the letters you wish to re-print."
  1. S DIR("A")="Enter re-print date: "
  1. D ^DIR K DIR
  1. S:$D(DIRUT) Y=-1
  1. Q +Y
  1. ;
  1. LTRTYPE(EATYP) ; Ask for a specific type of letter to print
  1. ; Input None
  1. ;
  1. ; Output EATYP Type of letter to reprint
  1. ; 1 - 60-day letter
  1. ; 2 - 30-day letter
  1. ; 4 - 0-day letter
  1. ;
  1. ; RESULT 1 if result of function Ok
  1. ; 0 if user enters "^" or exits
  1. ;
  1. N DIR,DIRUT
  1. ;
  1. S DIR(0)="SO^1:60-Day;2:30-Day;4:0-Day"
  1. S DIR("A")="Select letter type",DIR("A",1)=""
  1. S DIR("?")="Select the type of letter to re-print "
  1. D ^DIR K DIR
  1. Q:$D(DIRUT) 0
  1. S EATYP=+Y
  1. Q 1
  1. ;
  1. QUE1 ; Queue off the print job
  1. K IOP,IO("Q")
  1. N POP ;EAS*1.0*80
  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 QUEIT Q
  1. D EN1
  1. D ^%ZISC
  1. Q
  1. ;
  1. QUEIT ;
  1. N ZTRTN,ZTDESC,EASX,ZTSAVE,ZTSK,ZTDTH,ZTQUEUED
  1. ;
  1. S ZTRTN="EN1^EASMTL10"
  1. S ZTDESC="EAS MT LETTERS REPRINT"
  1. F EASX="EASDDD","EATYP","EASLOC" S ZTSAVE(EASX)=""
  1. S ZTDTH="NOW"
  1. ;
  1. D ^%ZTLOAD
  1. I $D(ZTSK)[0 W !!?5,"Reprint canceled"
  1. E W !!?5,"Letters queued, [",ZTSK,"]"
  1. D HOME^%ZIS
  1. Q
  1. ;
  1. EN1 ; Queued entry point for letter rerun
  1. N EASIEN,EASABRT,EASTMP
  1. ;
  1. S EASTMP="^TMP(""EASRP"",$J)"
  1. K @EASTMP
  1. ;
  1. I '$D(ZTQUEUED) W !,"...Gathering letters to re-print..."
  1. D BLD(EATYP,EASLOC,EASDDD,EASTMP)
  1. I '$D(ZTQUEUED),'$D(@EASTMP) D Q
  1. . W !?3,$CHAR(7),">> No letters found to reprint for these parameters.",!
  1. D PRINT(EASTMP,EATYP)
  1. K @EASTMP
  1. Q
  1. ;
  1. PRINT(EASTMP,EATYP) ;
  1. N EASIEN,EASABRT
  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)
  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. BLD(EATYP,EASLOC,EASDDD,EASTMP) ; Sort letters for processing date in groups by type
  1. N EASIEN,EASPTR,DFN,EASLTR
  1. ;
  1. S EASIEN=0
  1. F S EASIEN=$O(^EAS(713.2,"AD",EASDDD,EASIEN)) Q:'EASIEN D
  1. . ; Begin Checks
  1. . S EASPTR=$$GET1^DIQ(713.2,EASIEN,2,"I")
  1. . S DFN=$$GET1^DIQ(713.1,EASPTR,.01,"I")
  1. . ;; Filter by site, Quit if filter not met
  1. . I +$G(EASLOC)>0 Q:$$GET1^DIQ(2,DFN,27.02,"I")'=+EASLOC
  1. . Q:'$$THRSHLD^EASMTL6(EATYP,EASIEN) ; Quit if letter threshold not met
  1. . Q:$D(^EAS(713.2,"AC",1,EASIEN)) ; Quit if MT has been returned
  1. . Q:$D(^EAS(713.1,"AP",1,EASPTR)) ; Quit if prohibit flag set
  1. . Q:$$CHECKMT^EASMTUTL(EASPTR,EASIEN) ; Quit if MT no longer required
  1. . Q:$$FUTMT^EASMTUTL(EASIEN) ; Quit if future MT on file
  1. . Q:$$DECEASED^EASMTUTL(EASIEN) ; Quit if patient deceased
  1. . I $$CHKADR^EASMTL6A(EASPTR),EATYP'=3 Q ; Quit if bad address
  1. . ;EAS*1.0*80 -- copied User Enrollee check from BLD^EASMTL6
  1. . N EASUE S EASUE=$$UESTAT^EASUER(DFN)
  1. . Q:(EASUE'=1) ; Quit if User Enrollee site is not this facility
  1. . S @EASTMP@(EASIEN)=EATYP
  1. Q
  1. ;
  1. SINGLE ; Rerun a single letter
  1. N Y,DIR,DIRUT,EASPTR,DFN,EASIEN,ZTSAVE,EASLOC,IOP,EAX,PRNOVRD
  1. ;
  1. ASKPAT ; Select patient to reprint a letter for
  1. S DIR(0)="PAO^713.1:EMZ"
  1. S DIR("A")="Select PATIENT: "
  1. S DIR("?")="Select Patient Letter status entry to reprint"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S EASPTR=+Y ; Ptr to file 713.1
  1. S DFN=+Y(0)
  1. Q:'DFN
  1. ;
  1. I $D(^EAS(713.1,"AP",1,EASPTR)) D Q
  1. . W !!?4,$CHAR(7),"The Prohibit flag is set for this patient"
  1. I $$DECEASED^EASMTUTL("",DFN) D Q
  1. . W !!?4,$CHAR(7),"Patient is deceased"
  1. ;
  1. ASKLTR ; Select LETTER STATUS file entry
  1. S DIR(0)="P^713.2:EMZ"
  1. S DIR("?",1)="Select Processing Date: "
  1. S DIR("A")="Select the letter processing date for this patient"
  1. S DIR("S")="I $P(^(0),U,2)=EASPTR" ; Set screen for selected patient
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S EASIEN=+Y
  1. ;
  1. I $$GET1^DIQ(713.2,EASIEN,4,"I") D Q
  1. . W !!?4,$CHAR(7),"A Means Test has already been returned by this patient"
  1. ;
  1. I $$CHECKMT^EASMTUTL(EASPTR,EASIEN) D Q
  1. . W !!?4,$CHAR(7),"Patient's Means Test is no longer required"
  1. ;
  1. ASKTYP ; Allow only letters already sent to be reprinted
  1. N EASSC,EAX
  1. ;
  1. F EAX=6,4,"Z" D
  1. . I $P(^EAS(713.2,EASIEN,EAX),U,3) D
  1. . . I EAX=6 S EASSC=$G(EASSC)_"1:60-Day;"
  1. . . I EAX=4 S EASSC=$G(EASSC)_"2:30-Day;"
  1. . . I EAX="Z" S EASSC=$G(EASSC)_"4:0-Day"
  1. I $G(EASSC)']"" D Q
  1. . W !!?4,$CHAR(7),"There are no letters to re-print for this patient"
  1. ;
  1. S DIR(0)="SO^"_EASSC,DIR("A")="Select letter type"
  1. S DIR("?")="Select letter type to re-print"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S EATYP=+Y
  1. ;
  1. QUE2 ; Que off print letter
  1. S ZTSAVE("EASIEN")="",ZTSAVE("EASPTR")="",ZTSAVE("EATYP")="",ZTSAVE("EASLOC")=""
  1. D EN^XUTMDEVQ("EN2^EASMTL10","EAS MT RERUN SINGLE LETTER",.ZTSAVE)
  1. Q
  1. ;
  1. EN2 ; Queued entry point to re-run a single letter
  1. ;
  1. D LETTER^EASMTL6A(EASIEN,EATYP)
  1. Q
  1. ;
  1. LIST ; List last processing dates for the Letter Status file
  1. N EAX
  1. ;
  1. W !!,"Available Processing Dates:"
  1. S EAX=0
  1. F S EAX=$O(^EAS(713.2,"AD",EAX)) Q:'EAX D
  1. . W !?6,$$FMTE^XLFDT(EAX,"2D")
  1. Q
  1. ;
  1. NOTICE ;
  1. ;;Means Test Letters are indexed by the date on which the MT Letter search
  1. ;;occurred and is dependent on the frequency the search job is run at your
  1. ;;site. When you select the reprint date for a letter, the software will
  1. ;;try to determine the appropriate search (processing) date required to print
  1. ;;the desired letters. If the letters printed are not the desired letters,
  1. ;;you may need to try a later date.
  1. ;;