EASMTRPT ; MIN/TCM ALB/SCK - AUTOMATED MEANS TEST LETTERS REPORTS ; 7/6/01
;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,15**;MAR 15,2001
;
UNRTN ; Unreturned letters report
N EASN,CTR,EASNODE,TOT,EAS6,EASIEN,EAX
;
W @IOF
D WAIT^DICD
;
F EAX=0,30,60 S CTR(EAX)=0
;
S EASIEN=0
F S EASIEN=$O(^EAS(713.2,"AC",0,EASIEN)) Q:'EASIEN D
. I $P($G(^EAS(713.2,EASIEN,"Z")),U,3) S CTR(0)=CTR(0)+1 Q
. I $P($G(^EAS(713.2,EASIEN,4)),U,3) S CTR(30)=CTR(30)+1 Q
. I $P($G(^EAS(713.2,EASIEN,6)),U,3) S CTR(60)=CTR(60)+1 Q
PRT1 ;
W !!,$CHAR(7),"Summary of Most Recent Unreturned Means Test Letters"
;
W !!,"60-day letters printed: ",$J(CTR(60),6)
W !!,"30-day letters printed: ",$J(CTR(30),6)
W !!," 0-day letters printed: ",$J(CTR(0),6)
W !,"=============================="
S TOT=CTR(60)+CTR(30)+CTR(0)
W !!," Total: ",$J(TOT,6)
;
W !!
D PAUSE^EASMTUTL
;
Q
;
LTRSTAT ; Means Test Letter Statistics Report
N EASDT,EASB,EASE,ZTSAVE
;
S EASDT=$$ASK("Processing")
Q:'EASDT
;
S EASB=$P(EASDT,U,1),EASE=$P(EASDT,U,2)
S ZTSAVE("EASB")="",ZTSAVE("EASE")=""
;
D EN^XUTMDEVQ("QUE2^EASMTRPT","EAS MT LETTER STATISTICS REPORT",.ZTSAVE)
Q
;
QUE2 ; Queued entry point for letters statistics
N EAYTOT,EAYRTN,EAPRHB,EAS1,EASX,EAX,EASCMT,EAIEN
;
; Begin search Letter Status File, #713.2
; Set counters
S EAPRHB=0
F EASX=0,30,60 S EAYTOT(EASX)=0
F EASX="AG","OTR","OWN","FUT" S EAYRTN(EASX)=0
;
S EAS1=$$FMADD^XLFDT(EASB,"","","",-1)
F S EAS1=$O(^EAS(713.2,"B",EAS1)) Q:'EAS1!(EAS1>EASE) D
. S EAIEN=0
. F S EAIEN=$O(^EAS(713.2,"B",EAS1,EAIEN)) Q:'EAIEN D
. . I $P($G(^EAS(713.2,EAIEN,"Z")),U,3) S EAYTOT(0)=EAYTOT(0)+1
. . I $P($G(^EAS(713.2,EAIEN,4)),U,3) S EAYTOT(30)=EAYTOT(30)+1
. . I $P($G(^EAS(713.2,EAIEN,6)),U,3) S EAYTOT(60)=EAYTOT(60)+1
. . D INCPRHB(EAIEN,.EAPRHB)
. . I $P(^EAS(713.2,EAIEN,0),U,4) D
. . . K EASCMT
. . . S EAX=$$GET1^DIQ(713.2,EAIEN,7,"","EASCMT")
. . . I $G(EASCMT(1))["AUTO-GENERATED" S EAYRTN("AG")=EAYRTN("AG")+1 Q
. . . I $G(EASCMT(1))["'OWNED'" S EAYRTN("OWN")=EAYRTN("OWN")+1 Q
. . . I $G(EASCMT(1))["FUTURE MEANS TEST" S EAYRTN("FUT")=EAYRTN("FUT")+1 Q
. . . S EAYRTN("OTR")=EAYRTN("OTR")+1
;
PRT2 ;
N LINE,TAB
;
W @IOF
W !,"MEANS TEST LETTERS STATISTIC REPORT"
W !,"Letter Processing Date Range: ",$$FMTE^XLFDT(EASB)," thru ",$$FMTE^XLFDT(EASE)
W !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
;
W !!,"Letter type:",?25,"60-day",?35,"30-day",?45,"0-day",?55,"Totals"
S $P(LINE,"=",IOM)="" W !,LINE
;
W !!,"Letters printed:"
W ?25,EAYTOT(60),?35,EAYTOT(30),?45,EAYTOT(0)
W ?55,EAYTOT(60)+EAYTOT(30)+EAYTOT(0)
;
W !!,"Means Test returned Totals"
W !," AUTO-GENERATED:",?35,$FN(EAYRTN("AG"),",")
W !," Future MT:",?35,$FN(EAYRTN("FUT"),",")
W !," Owned by Other Site:",?35,$FN(EAYRTN("OWN"),",")
W !," Returned by Veteran:",?35,$FN(EAYRTN("OTR"),",")
W !," Total:",?35,$FN(EAYRTN("AG")+EAYRTN("OWN")+EAYRTN("OTR")+EAYRTN("FUT"),",")
W !!,"Count of patient records set to prohibit letter during date range: ",$G(EAPRHB)
I $E(IOST,1,2)="C-" D PAUSE^EASMTUTL
Q
;
SUMMRY ; Automated MT Ltrs Summary
N SDATE,EDATE,EASDT,SDISP,EDISP,EAX
;
S EASDT=$$ASK("Processing")
Q:'EASDT
S (SDATE,SDISP)=$P(EASDT,U)
S (EDATE,EDISP)=$P(EASDT,U,2)
S SDATE=$$FMADD^XLFDT(SDATE,"","","",-1)
S ZTSAVE("SDATE")="",ZTSAVE("EDATE")="",ZTSAVE("SDISP")="",ZTSAVE("EDISP")=""
W !!,$CHAR(7),"A 132-Column printer is required for this report"
D EN^XUTMDEVQ("QUE3^EASMTRPT","EAS MT PROCESSING SUMMARY REPORT",.ZTSAVE)
Q
;
QUE3 ; PROCESSING SUMMARY REPORT
N EASN,EASIEN,EANODE,EALNE,EATYP,PAGE,EASABRT,COL,EAWP,WP
N COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9
;
S COL1=0,COL2=10,COL3=50,COL4=63,COL5=73,COL6=84,COL7=95,COL8=108,COL9=120
S PAGE=1
D HDR("AUTOMATED MT LETTERS SUMMARY",SDISP,EDISP)
;
W !!,"Entry",?COL2,"Patient",?COL3,"Means Test",?COL4,"Letter",?COL5,"Print",?COL6,"Flag to",?COL7,"Letter",?COL8,"Print",?COL9,"Prohibit"
W !,?COL3,"Date",?COL4,"Type",?COL5,"Date",?COL6,"Print",?COL7,"Printed?",?COL8,"Date",?COL9,"Flag?",!
;
S EASN=SDATE
F S EASN=$O(^EAS(713.2,"AD",EASN)) Q:'EASN!(EASN>EDATE) D Q:$G(EASABRT)
. S EASIEN=0
. F S EASIEN=$O(^EAS(713.2,"AD",EASN,EASIEN)) Q:'EASIEN D Q:$G(EASABRT)
. . K EANODE0 S EANODE0=$G(^EAS(713.2,EASIEN,0))
. . W !,EASIEN,?COL2,$E($$GET1^DIQ(713.2,EASIEN,2),1,25)_" ("_$$LAST4($P(EANODE0,U,2))_")"
. . I $$DECEASED^EASMTUTL(EASIEN) W " *D*"
. . W ?COL3,$$FMTE^XLFDT($P(EANODE0,U,3),"2D")
. . K EANODE6 S EANODE6=$G(^EAS(713.2,EASIEN,6))
. . W ?COL4,"60-Day",?COL5,$$FMTE^XLFDT($P(EANODE6,U,1),"2D"),?COL6,$S($P(EANODE6,U,2)=1:"YES",1:"NO")
. . W ?COL7,$S($P(EANODE6,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($P(EANODE6,U,4),"2D"),?COL9
. . I $D(^EAS(713.1,"AP",1,$P(EANODE0,U,2))) W "YES"
. . W !
. . I $P($G(EANODE0),U,4) W ?15,"MT Returned: ",$$FMTE^XLFDT($P(EANODE0,U,5),"2D")
. . K EANODE4 S EANODE4=$G(^EAS(713.2,EASIEN,4))
. . W ?COL4,"30-Day",?COL5,$$FMTE^XLFDT($P(EANODE4,U,1),"2D"),?COL6,$S($P(EANODE4,U,2)=1:"YES",1:"NO")
. . W ?COL7,$S($P(EANODE4,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($P(EANODE4,U,4),"2D"),!
. . W ?15 I $P($G(EANODE0),U,4) K WP S EAWP=$$GET1^DIQ(713.2,EASIEN,7,"","WP") D
. . . Q:$G(EAWP)']""
. . . W $E(WP(1),1,30)
. . K EANODEZ S EANODEZ=$G(^EAS(713.2,EASIEN,"Z"))
. . W ?COL4,"0-Day",?COL5,$$FMTE^XLFDT($P(EANODEZ,U,1),"2D"),?COL6,$S($P(EANODEZ,U,2)=1:"YES",1:"NO")
. . W ?COL7,$S($P(EANODEZ,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($P(EANODEZ,U,4),"2D"),!
. . S $P(LINE,"-",IOM)="" W !?42,$E(LINE,1,IOM-42)
. . I ($Y+6)>IOSL D
. . . D HDR("AUTOMATED MT LETTERS SUMMARY",SDISP,EDISP)
. . . Q:$G(EASABRT)
. . . W !!,"Entry",?COL2,"Patient",?COL3,"Means Test",?COL4,"Letter",?COL5,"Print",?COL6,"Flag to",?COL7,"Letter",?COL8,"Print",?COL9,"Prohibit"
. . . W !,?COL3,"Date",?COL4,"Type",?COL5,"Date",?COL6,"Print",?COL7,"Printed?",?COL8,"Date",?COL9,"Flag?",!
Q
;
HDR(TITLE,SDISP,EDISP) ; Print report header
N LINE,TAB
;
I $E(IOST,1,2)="C-" D Q:$G(EASABRT)
. S DIR(0)="E"
. D ^DIR K DIR
. I 'Y S EASABRT=1
;
W @IOF
W TITLE
I SDISP>0,EDISP>0 W !,"Date Range: ",$$FMTE^XLFDT(SDISP)," thru ",$$FMTE^XLFDT(EDISP)
;
W !!,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
S TAB=IOM-8
I $G(PAGE) W ?TAB,"Page "_PAGE S PAGE=PAGE+1
;
S $P(LINE,"=",IOM)="" W !,LINE
Q
;
ASK(PRMPT) ; Get Date range
N DIR,DIRUT,SDATE,EDATE
;
; Get date range for the report
S DIR(0)="DAO^2881001:DT:EX"
S DIR("A")="Start with "_PRMPT_" date: "
S DIR("?",1)="Date cannot be earlier than October 1, 1988"
S DIR("?")="^D HELP^%DTC"
S DIR("B")="OCT 1, 1998"
D ^DIR
I $D(DIRUT) Q 0
S SDATE=Y
;
S DIR(0)="DAO^"_SDATE_"::EX"
S DIR("A")="Ending "_PRMPT_" date: "
S DIR("?",1)="Date must after "_$$FMTE^XLFDT(SDATE)
S DIR("?")="^D HELP^%DTC"
S DIR("B")="TODAY"
D ^DIR K DIR
I $D(DIRUT) Q 0
S EDATE=Y
Q $G(SDATE)_U_$G(EDATE)
;
INCPRHB(EASN,EAPRHB) ; Increment Prohibited Letters Flag count
; Input
; EASN -
; EAPRHB -
;
N EASPAT,EASDFN
;
Q:'EASN
S EASPAT=$G(^EAS(713.2,EASN,2))
Q:'EASPAT
I $D(^EAS(713.1,"AP",1,EASPAT)) D
. S EAPRHB=EAPRHB+1
. S EASDFN=$O(^EAS(713.1,"B",EASPAT,0))
. S EAPRHB(EASDFN)=""
Q
;
LAST4(EASIEN) ; Return last four for patient
N DFN,RSLT
;
S DFN=$$GET1^DIQ(713.1,EASIEN,.01,"I")
I '$G(DFN) Q 0
D PID^VADPT
S RSLT=VA("BID")
D KVA^VADPT
Q RSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASMTRPT 7585 printed Sep 23, 2025@19:31:38 Page 2
EASMTRPT ; MIN/TCM ALB/SCK - AUTOMATED MEANS TEST LETTERS REPORTS ; 7/6/01
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**3,12,15**;MAR 15,2001
+2 ;
UNRTN ; Unreturned letters report
+1 NEW EASN,CTR,EASNODE,TOT,EAS6,EASIEN,EAX
+2 ;
+3 WRITE @IOF
+4 DO WAIT^DICD
+5 ;
+6 FOR EAX=0,30,60
SET CTR(EAX)=0
+7 ;
+8 SET EASIEN=0
+9 FOR
SET EASIEN=$ORDER(^EAS(713.2,"AC",0,EASIEN))
if 'EASIEN
QUIT
Begin DoDot:1
+10 IF $PIECE($GET(^EAS(713.2,EASIEN,"Z")),U,3)
SET CTR(0)=CTR(0)+1
QUIT
+11 IF $PIECE($GET(^EAS(713.2,EASIEN,4)),U,3)
SET CTR(30)=CTR(30)+1
QUIT
+12 IF $PIECE($GET(^EAS(713.2,EASIEN,6)),U,3)
SET CTR(60)=CTR(60)+1
QUIT
End DoDot:1
PRT1 ;
+1 WRITE !!,$CHAR(7),"Summary of Most Recent Unreturned Means Test Letters"
+2 ;
+3 WRITE !!,"60-day letters printed: ",$JUSTIFY(CTR(60),6)
+4 WRITE !!,"30-day letters printed: ",$JUSTIFY(CTR(30),6)
+5 WRITE !!," 0-day letters printed: ",$JUSTIFY(CTR(0),6)
+6 WRITE !,"=============================="
+7 SET TOT=CTR(60)+CTR(30)+CTR(0)
+8 WRITE !!," Total: ",$JUSTIFY(TOT,6)
+9 ;
+10 WRITE !!
+11 DO PAUSE^EASMTUTL
+12 ;
+13 QUIT
+14 ;
LTRSTAT ; Means Test Letter Statistics Report
+1 NEW EASDT,EASB,EASE,ZTSAVE
+2 ;
+3 SET EASDT=$$ASK("Processing")
+4 if 'EASDT
QUIT
+5 ;
+6 SET EASB=$PIECE(EASDT,U,1)
SET EASE=$PIECE(EASDT,U,2)
+7 SET ZTSAVE("EASB")=""
SET ZTSAVE("EASE")=""
+8 ;
+9 DO EN^XUTMDEVQ("QUE2^EASMTRPT","EAS MT LETTER STATISTICS REPORT",.ZTSAVE)
+10 QUIT
+11 ;
QUE2 ; Queued entry point for letters statistics
+1 NEW EAYTOT,EAYRTN,EAPRHB,EAS1,EASX,EAX,EASCMT,EAIEN
+2 ;
+3 ; Begin search Letter Status File, #713.2
+4 ; Set counters
+5 SET EAPRHB=0
+6 FOR EASX=0,30,60
SET EAYTOT(EASX)=0
+7 FOR EASX="AG","OTR","OWN","FUT"
SET EAYRTN(EASX)=0
+8 ;
+9 SET EAS1=$$FMADD^XLFDT(EASB,"","","",-1)
+10 FOR
SET EAS1=$ORDER(^EAS(713.2,"B",EAS1))
if 'EAS1!(EAS1>EASE)
QUIT
Begin DoDot:1
+11 SET EAIEN=0
+12 FOR
SET EAIEN=$ORDER(^EAS(713.2,"B",EAS1,EAIEN))
if 'EAIEN
QUIT
Begin DoDot:2
+13 IF $PIECE($GET(^EAS(713.2,EAIEN,"Z")),U,3)
SET EAYTOT(0)=EAYTOT(0)+1
+14 IF $PIECE($GET(^EAS(713.2,EAIEN,4)),U,3)
SET EAYTOT(30)=EAYTOT(30)+1
+15 IF $PIECE($GET(^EAS(713.2,EAIEN,6)),U,3)
SET EAYTOT(60)=EAYTOT(60)+1
+16 DO INCPRHB(EAIEN,.EAPRHB)
+17 IF $PIECE(^EAS(713.2,EAIEN,0),U,4)
Begin DoDot:3
+18 KILL EASCMT
+19 SET EAX=$$GET1^DIQ(713.2,EAIEN,7,"","EASCMT")
+20 IF $GET(EASCMT(1))["AUTO-GENERATED"
SET EAYRTN("AG")=EAYRTN("AG")+1
QUIT
+21 IF $GET(EASCMT(1))["'OWNED'"
SET EAYRTN("OWN")=EAYRTN("OWN")+1
QUIT
+22 IF $GET(EASCMT(1))["FUTURE MEANS TEST"
SET EAYRTN("FUT")=EAYRTN("FUT")+1
QUIT
+23 SET EAYRTN("OTR")=EAYRTN("OTR")+1
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
PRT2 ;
+1 NEW LINE,TAB
+2 ;
+3 WRITE @IOF
+4 WRITE !,"MEANS TEST LETTERS STATISTIC REPORT"
+5 WRITE !,"Letter Processing Date Range: ",$$FMTE^XLFDT(EASB)," thru ",$$FMTE^XLFDT(EASE)
+6 WRITE !,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
+7 ;
+8 WRITE !!,"Letter type:",?25,"60-day",?35,"30-day",?45,"0-day",?55,"Totals"
+9 SET $PIECE(LINE,"=",IOM)=""
WRITE !,LINE
+10 ;
+11 WRITE !!,"Letters printed:"
+12 WRITE ?25,EAYTOT(60),?35,EAYTOT(30),?45,EAYTOT(0)
+13 WRITE ?55,EAYTOT(60)+EAYTOT(30)+EAYTOT(0)
+14 ;
+15 WRITE !!,"Means Test returned Totals"
+16 WRITE !," AUTO-GENERATED:",?35,$FNUMBER(EAYRTN("AG"),",")
+17 WRITE !," Future MT:",?35,$FNUMBER(EAYRTN("FUT"),",")
+18 WRITE !," Owned by Other Site:",?35,$FNUMBER(EAYRTN("OWN"),",")
+19 WRITE !," Returned by Veteran:",?35,$FNUMBER(EAYRTN("OTR"),",")
+20 WRITE !," Total:",?35,$FNUMBER(EAYRTN("AG")+EAYRTN("OWN")+EAYRTN("OTR")+EAYRTN("FUT"),",")
+21 WRITE !!,"Count of patient records set to prohibit letter during date range: ",$GET(EAPRHB)
+22 IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^EASMTUTL
+23 QUIT
+24 ;
SUMMRY ; Automated MT Ltrs Summary
+1 NEW SDATE,EDATE,EASDT,SDISP,EDISP,EAX
+2 ;
+3 SET EASDT=$$ASK("Processing")
+4 if 'EASDT
QUIT
+5 SET (SDATE,SDISP)=$PIECE(EASDT,U)
+6 SET (EDATE,EDISP)=$PIECE(EASDT,U,2)
+7 SET SDATE=$$FMADD^XLFDT(SDATE,"","","",-1)
+8 SET ZTSAVE("SDATE")=""
SET ZTSAVE("EDATE")=""
SET ZTSAVE("SDISP")=""
SET ZTSAVE("EDISP")=""
+9 WRITE !!,$CHAR(7),"A 132-Column printer is required for this report"
+10 DO EN^XUTMDEVQ("QUE3^EASMTRPT","EAS MT PROCESSING SUMMARY REPORT",.ZTSAVE)
+11 QUIT
+12 ;
QUE3 ; PROCESSING SUMMARY REPORT
+1 NEW EASN,EASIEN,EANODE,EALNE,EATYP,PAGE,EASABRT,COL,EAWP,WP
+2 NEW COL1,COL2,COL3,COL4,COL5,COL6,COL7,COL8,COL9
+3 ;
+4 SET COL1=0
SET COL2=10
SET COL3=50
SET COL4=63
SET COL5=73
SET COL6=84
SET COL7=95
SET COL8=108
SET COL9=120
+5 SET PAGE=1
+6 DO HDR("AUTOMATED MT LETTERS SUMMARY",SDISP,EDISP)
+7 ;
+8 WRITE !!,"Entry",?COL2,"Patient",?COL3,"Means Test",?COL4,"Letter",?COL5,"Print",?COL6,"Flag to",?COL7,"Letter",?COL8,"Print",?COL9,"Prohibit"
+9 WRITE !,?COL3,"Date",?COL4,"Type",?COL5,"Date",?COL6,"Print",?COL7,"Printed?",?COL8,"Date",?COL9,"Flag?",!
+10 ;
+11 SET EASN=SDATE
+12 FOR
SET EASN=$ORDER(^EAS(713.2,"AD",EASN))
if 'EASN!(EASN>EDATE)
QUIT
Begin DoDot:1
+13 SET EASIEN=0
+14 FOR
SET EASIEN=$ORDER(^EAS(713.2,"AD",EASN,EASIEN))
if 'EASIEN
QUIT
Begin DoDot:2
+15 KILL EANODE0
SET EANODE0=$GET(^EAS(713.2,EASIEN,0))
+16 WRITE !,EASIEN,?COL2,$EXTRACT($$GET1^DIQ(713.2,EASIEN,2),1,25)_" ("_$$LAST4($PIECE(EANODE0,U,2))_")"
+17 IF $$DECEASED^EASMTUTL(EASIEN)
WRITE " *D*"
+18 WRITE ?COL3,$$FMTE^XLFDT($PIECE(EANODE0,U,3),"2D")
+19 KILL EANODE6
SET EANODE6=$GET(^EAS(713.2,EASIEN,6))
+20 WRITE ?COL4,"60-Day",?COL5,$$FMTE^XLFDT($PIECE(EANODE6,U,1),"2D"),?COL6,$SELECT($PIECE(EANODE6,U,2)=1:"YES",1:"NO")
+21 WRITE ?COL7,$SELECT($PIECE(EANODE6,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($PIECE(EANODE6,U,4),"2D"),?COL9
+22 IF $DATA(^EAS(713.1,"AP",1,$PIECE(EANODE0,U,2)))
WRITE "YES"
+23 WRITE !
+24 IF $PIECE($GET(EANODE0),U,4)
WRITE ?15,"MT Returned: ",$$FMTE^XLFDT($PIECE(EANODE0,U,5),"2D")
+25 KILL EANODE4
SET EANODE4=$GET(^EAS(713.2,EASIEN,4))
+26 WRITE ?COL4,"30-Day",?COL5,$$FMTE^XLFDT($PIECE(EANODE4,U,1),"2D"),?COL6,$SELECT($PIECE(EANODE4,U,2)=1:"YES",1:"NO")
+27 WRITE ?COL7,$SELECT($PIECE(EANODE4,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($PIECE(EANODE4,U,4),"2D"),!
+28 WRITE ?15
IF $PIECE($GET(EANODE0),U,4)
KILL WP
SET EAWP=$$GET1^DIQ(713.2,EASIEN,7,"","WP")
Begin DoDot:3
+29 if $GET(EAWP)']""
QUIT
+30 WRITE $EXTRACT(WP(1),1,30)
End DoDot:3
+31 KILL EANODEZ
SET EANODEZ=$GET(^EAS(713.2,EASIEN,"Z"))
+32 WRITE ?COL4,"0-Day",?COL5,$$FMTE^XLFDT($PIECE(EANODEZ,U,1),"2D"),?COL6,$SELECT($PIECE(EANODEZ,U,2)=1:"YES",1:"NO")
+33 WRITE ?COL7,$SELECT($PIECE(EANODEZ,U,3)=1:"YES",1:"NO"),?COL8,$$FMTE^XLFDT($PIECE(EANODEZ,U,4),"2D"),!
+34 SET $PIECE(LINE,"-",IOM)=""
WRITE !?42,$EXTRACT(LINE,1,IOM-42)
+35 IF ($Y+6)>IOSL
Begin DoDot:3
+36 DO HDR("AUTOMATED MT LETTERS SUMMARY",SDISP,EDISP)
+37 if $GET(EASABRT)
QUIT
+38 WRITE !!,"Entry",?COL2,"Patient",?COL3,"Means Test",?COL4,"Letter",?COL5,"Print",?COL6,"Flag to",?COL7,"Letter",?COL8,"Print",?COL9,"Prohibit"
+39 WRITE !,?COL3,"Date",?COL4,"Type",?COL5,"Date",?COL6,"Print",?COL7,"Printed?",?COL8,"Date",?COL9,"Flag?",!
End DoDot:3
End DoDot:2
if $GET(EASABRT)
QUIT
End DoDot:1
if $GET(EASABRT)
QUIT
+40 QUIT
+41 ;
HDR(TITLE,SDISP,EDISP) ; Print report header
+1 NEW LINE,TAB
+2 ;
+3 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+4 SET DIR(0)="E"
+5 DO ^DIR
KILL DIR
+6 IF 'Y
SET EASABRT=1
End DoDot:1
if $GET(EASABRT)
QUIT
+7 ;
+8 WRITE @IOF
+9 WRITE TITLE
+10 IF SDISP>0
IF EDISP>0
WRITE !,"Date Range: ",$$FMTE^XLFDT(SDISP)," thru ",$$FMTE^XLFDT(EDISP)
+11 ;
+12 WRITE !!,"Print Date: ",$$FMTE^XLFDT($$NOW^XLFDT)
+13 SET TAB=IOM-8
+14 IF $GET(PAGE)
WRITE ?TAB,"Page "_PAGE
SET PAGE=PAGE+1
+15 ;
+16 SET $PIECE(LINE,"=",IOM)=""
WRITE !,LINE
+17 QUIT
+18 ;
ASK(PRMPT) ; Get Date range
+1 NEW DIR,DIRUT,SDATE,EDATE
+2 ;
+3 ; Get date range for the report
+4 SET DIR(0)="DAO^2881001:DT:EX"
+5 SET DIR("A")="Start with "_PRMPT_" date: "
+6 SET DIR("?",1)="Date cannot be earlier than October 1, 1988"
+7 SET DIR("?")="^D HELP^%DTC"
+8 SET DIR("B")="OCT 1, 1998"
+9 DO ^DIR
+10 IF $DATA(DIRUT)
QUIT 0
+11 SET SDATE=Y
+12 ;
+13 SET DIR(0)="DAO^"_SDATE_"::EX"
+14 SET DIR("A")="Ending "_PRMPT_" date: "
+15 SET DIR("?",1)="Date must after "_$$FMTE^XLFDT(SDATE)
+16 SET DIR("?")="^D HELP^%DTC"
+17 SET DIR("B")="TODAY"
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DIRUT)
QUIT 0
+20 SET EDATE=Y
+21 QUIT $GET(SDATE)_U_$GET(EDATE)
+22 ;
INCPRHB(EASN,EAPRHB) ; Increment Prohibited Letters Flag count
+1 ; Input
+2 ; EASN -
+3 ; EAPRHB -
+4 ;
+5 NEW EASPAT,EASDFN
+6 ;
+7 if 'EASN
QUIT
+8 SET EASPAT=$GET(^EAS(713.2,EASN,2))
+9 if 'EASPAT
QUIT
+10 IF $DATA(^EAS(713.1,"AP",1,EASPAT))
Begin DoDot:1
+11 SET EAPRHB=EAPRHB+1
+12 SET EASDFN=$ORDER(^EAS(713.1,"B",EASPAT,0))
+13 SET EAPRHB(EASDFN)=""
End DoDot:1
+14 QUIT
+15 ;
LAST4(EASIEN) ; Return last four for patient
+1 NEW DFN,RSLT
+2 ;
+3 SET DFN=$$GET1^DIQ(713.1,EASIEN,.01,"I")
+4 IF '$GET(DFN)
QUIT 0
+5 DO PID^VADPT
+6 SET RSLT=VA("BID")
+7 DO KVA^VADPT
+8 QUIT RSLT
