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