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