- 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 Jan 18, 2025@02:56:38 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 ;;