SDMHPRO ;MAF/ALB - MENTAL HEALTH PROACTIVE HIGH RISK REPORT (BGJ);AUGUST 30, 2011
;;5.3;Scheduling;**588**;Aug 13,1993;Build 53
;
EN ;entry point for the automatic generation of the Proactive Report from BGJ
N SDBEG,SDEND,VAUTD,Y,SDUP,SDXFLG,SDDAT,X1,X2,SDTL,X,VAUTCL,SDPAG,SDX,TOTAL,IOM,SDNSDT,%,SDALL
K ^TMP("SDMHP",$J)
S SDXFLG=1 ; This flag is set to 1 when it is from the background Job
D NOW^%DTC S Y=$E(%,1,12) S SDDAT=$$FMTE^XLFDT(Y,"5"),SDBEG=$P(Y,".",1)_".0000",SDEND=$P(Y,".",1)_".2359"
S SDNSDT=$$FMTE^XLFDT(Y,"2")
S VAUTD=1 ;All the divisions in the facility
S SDTL="CLIN",SDALL="M" ; sort by clinc and only mental health clinics for the BGJ
S IOM=80
N SDLN
S X="",SDLN=0
D START^SDMHAP
B N XMSUB,XMY,XMTEXT,XMDUZ,SDGRP
S SDGRP=$O(^XMB(3.8,"B","SD MH NO SHOW NOTIFICATION",""))
Q:'SDGRP
D XMY^SDUTL2(SDGRP,0,0)
S XMSUB="HRMH PROACTIVE NIGHTLY REPORT"_" MESSAGE # "
S XMTEXT="^TMP(""SDMHP"",$J,"
S XMDUZ="POSTMASTER"
D ^XMD
K ^TMP("SDMHP",$J)
Q
SET(X) ; SET UP THE STRING
S SDLN=SDLN+1,^TMP("SDMHP",$J,SDLN,0)=X
Q
HEAD ;Heading for the report
;
N SDX
S SDX="",X=""
S SDPAG=SDPAG+1,SDX=$$SETSTR^SDMHPRO1("HIGH RISK MENTAL HEALTH PROACTIVE NIGHTLY REPORT",X,1,48)_$$SETSTR^SDMHPRO1(" PAGE ",X,20,6)_$$SETSTR^SDMHPRO1(SDPAG,X,4,4) D SET1^SDMHPRO1(SDX)
S SDX=$$SETSTR^SDMHPRO1("By "_$S(SDTL="MEN":"MENTAL HEALTH QUICK LIST",SDTL="STOP":"STOPCODE",1:"Patient")_" for Appointments on "_$P(SDNSDT,"@",1),X,1,50)_$$SETSTR^SDMHPRO1("Run: "_SDDAT,X,9,30) D SET1^SDMHPRO1(SDX)
S SDX=$$SETSTR^SDMHPRO1("#",X,1,1)_$$SETSTR^SDMHPRO1("PATIENT",X,4,8)_$$SETSTR^SDMHPRO1("PT ID",X,14,5)_$$SETSTR^SDMHPRO1("APPT D/T",X,2,16)_$$SETSTR^SDMHPRO1("CLINIC",X,2,15) D SET1^SDMHPRO1(SDX)
S SDX=$$SETSTR^SDMHPRO1($$LINE^SDMHAP(""),X,1,80) D SET1^SDMHPRO1(SDX)
HEAD1 I $D(^TMP(NAMSPC1,$J)),$D(SDXDIV) S SDX=$$SETSTR^SDMHPRO1("DIVISION: "_$E(SDXDIV,1,24),X,1,80) D SET1^SDMHPRO1(SDX)
I '$D(^TMP(NAMSPC1,$J)),'$D(SDXDIV) S SDX=$$SETSTR^SDMHPRO1($$LINE1^SDMHAP(">>>>>>>>>>>>> NO RECORDS <<<<<<<<<<<<<"),X,1,80) D SET1^SDMHPRO1(SDX)
Q
;
TOTAL ;Prints totals for the clinics by division - FOR BGJ
Q:'$D(TOTAL)
N SDVISN,SDCLNIC,SDFLAG,SDX,X
S (SDVISN)=0
S X="",SDX=""
S SDX=$$SETSTR^SDMHPRO1("Division Totals",X,1,80) D SET1^SDMHPRO1(SDX)
S X="",SDX=""
S SDX=$$SETSTR^SDMHPRO1("Division",X,1,26)_$$SETSTR^SDMHPRO1("Unique",X,29,6) D SET1^SDMHPRO1(SDX)
S X="",SDX="" S SDX=$$SETSTR^SDMHPRO1("Patients",X,54,24) D SET1^SDMHPRO1(SDX)
F S SDVISN=$O(TOTAL(SDVISN)) Q:SDVISN']"" D
. N SDX,X
.I $D(TOTAL(SDVISN)) D
..S SDX="",X=""
..N SDTOTS
..S SDTOTS=$J($P(TOTAL(SDVISN),"^",5),3)
..S SDX=$$SETSTR^SDMHPRO1($E(SDVISN,1,24),X,1,54)_$$SETSTR^SDMHPRO1(SDTOTS,X,1,24) D SET1^SDMHPRO1(SDX)
S X="",SDX="" S SDX=$$SETSTR^SDMHPRO1(" ",X,1,80) D SET1^SDMHPRO1(SDX)
S X="",SDX=""
Q
TOTAL1 ;TOTALS FOR AD HOC
Q:'$D(TOTAL)
N SDVISN,SDCLNIC,SDFLAG,SDX,X
S (SDVISN,SDCLNIC)=0
W ?25,"Division/Clinic Appointment Totals",!!
W "Division/CLinic",?50,"Unique",!
W ?49,"Patients",!!
F S SDVISN=$O(TOTAL(SDVISN)) Q:SDVISN']"" D
.I $D(TOTAL(SDVISN)) D
..N SDTOTS
..S SDTOTS=$J($P(TOTAL(SDVISN),"^",5),3)
..W $E(SDVISN,1,30),?50,SDTOTS,! D RET^SDMHAP1 Q:SDUP
W ! D RET^SDMHAP1 Q:SDUP
Q
COUNT ; COUNTER
S SDCOUNT=SDCOUNT+1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDMHPRO 3322 printed Nov 22, 2024@18:08:33 Page 2
SDMHPRO ;MAF/ALB - MENTAL HEALTH PROACTIVE HIGH RISK REPORT (BGJ);AUGUST 30, 2011
+1 ;;5.3;Scheduling;**588**;Aug 13,1993;Build 53
+2 ;
EN ;entry point for the automatic generation of the Proactive Report from BGJ
+1 NEW SDBEG,SDEND,VAUTD,Y,SDUP,SDXFLG,SDDAT,X1,X2,SDTL,X,VAUTCL,SDPAG,SDX,TOTAL,IOM,SDNSDT,%,SDALL
+2 KILL ^TMP("SDMHP",$JOB)
+3 ; This flag is set to 1 when it is from the background Job
SET SDXFLG=1
+4 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
SET SDDAT=$$FMTE^XLFDT(Y,"5")
SET SDBEG=$PIECE(Y,".",1)_".0000"
SET SDEND=$PIECE(Y,".",1)_".2359"
+5 SET SDNSDT=$$FMTE^XLFDT(Y,"2")
+6 ;All the divisions in the facility
SET VAUTD=1
+7 ; sort by clinc and only mental health clinics for the BGJ
SET SDTL="CLIN"
SET SDALL="M"
+8 SET IOM=80
+9 NEW SDLN
+10 SET X=""
SET SDLN=0
+11 DO START^SDMHAP
B NEW XMSUB,XMY,XMTEXT,XMDUZ,SDGRP
+1 SET SDGRP=$ORDER(^XMB(3.8,"B","SD MH NO SHOW NOTIFICATION",""))
+2 if 'SDGRP
QUIT
+3 DO XMY^SDUTL2(SDGRP,0,0)
+4 SET XMSUB="HRMH PROACTIVE NIGHTLY REPORT"_" MESSAGE # "
+5 SET XMTEXT="^TMP(""SDMHP"",$J,"
+6 SET XMDUZ="POSTMASTER"
+7 DO ^XMD
+8 KILL ^TMP("SDMHP",$JOB)
+9 QUIT
SET(X) ; SET UP THE STRING
+1 SET SDLN=SDLN+1
SET ^TMP("SDMHP",$JOB,SDLN,0)=X
+2 QUIT
HEAD ;Heading for the report
+1 ;
+2 NEW SDX
+3 SET SDX=""
SET X=""
+4 SET SDPAG=SDPAG+1
SET SDX=$$SETSTR^SDMHPRO1("HIGH RISK MENTAL HEALTH PROACTIVE NIGHTLY REPORT",X,1,48)_$$SETSTR^SDMHPRO1(" PAGE ",X,20,6)_$$SETSTR^SDMHPRO1(SDPAG,X,4,4)
DO SET1^SDMHPRO1(SDX)
+5 SET SDX=$$SETSTR^SDMHPRO1("By "_$SELECT(SDTL="MEN":"MENTAL HEALTH QUICK LIST",SDTL="STOP":"STOPCODE",1:"Patient")_" for Appointments on "_$PIECE(SDNSDT,"@",1),X,1,50)_$$SETSTR^SDMHPRO1("Run: "_SDDAT,X,9,30)
DO SET1^SDMHPRO1(SDX)
+6 SET SDX=$$SETSTR^SDMHPRO1("#",X,1,1)_$$SETSTR^SDMHPRO1("PATIENT",X,4,8)_$$SETSTR^SDMHPRO1("PT ID",X,14,5)_$$SETSTR^SDMHPRO1("APPT D/T",X,2,16)_$$SETSTR^SDMHPRO1("CLINIC",X,2,15)
DO SET1^SDMHPRO1(SDX)
+7 SET SDX=$$SETSTR^SDMHPRO1($$LINE^SDMHAP(""),X,1,80)
DO SET1^SDMHPRO1(SDX)
HEAD1 IF $DATA(^TMP(NAMSPC1,$JOB))
IF $DATA(SDXDIV)
SET SDX=$$SETSTR^SDMHPRO1("DIVISION: "_$EXTRACT(SDXDIV,1,24),X,1,80)
DO SET1^SDMHPRO1(SDX)
+1 IF '$DATA(^TMP(NAMSPC1,$JOB))
IF '$DATA(SDXDIV)
SET SDX=$$SETSTR^SDMHPRO1($$LINE1^SDMHAP(">>>>>>>>>>>>> NO RECORDS <<<<<<<<<<<<<"),X,1,80)
DO SET1^SDMHPRO1(SDX)
+2 QUIT
+3 ;
TOTAL ;Prints totals for the clinics by division - FOR BGJ
+1 if '$DATA(TOTAL)
QUIT
+2 NEW SDVISN,SDCLNIC,SDFLAG,SDX,X
+3 SET (SDVISN)=0
+4 SET X=""
SET SDX=""
+5 SET SDX=$$SETSTR^SDMHPRO1("Division Totals",X,1,80)
DO SET1^SDMHPRO1(SDX)
+6 SET X=""
SET SDX=""
+7 SET SDX=$$SETSTR^SDMHPRO1("Division",X,1,26)_$$SETSTR^SDMHPRO1("Unique",X,29,6)
DO SET1^SDMHPRO1(SDX)
+8 SET X=""
SET SDX=""
SET SDX=$$SETSTR^SDMHPRO1("Patients",X,54,24)
DO SET1^SDMHPRO1(SDX)
+9 FOR
SET SDVISN=$ORDER(TOTAL(SDVISN))
if SDVISN']""
QUIT
Begin DoDot:1
+10 NEW SDX,X
+11 IF $DATA(TOTAL(SDVISN))
Begin DoDot:2
+12 SET SDX=""
SET X=""
+13 NEW SDTOTS
+14 SET SDTOTS=$JUSTIFY($PIECE(TOTAL(SDVISN),"^",5),3)
+15 SET SDX=$$SETSTR^SDMHPRO1($EXTRACT(SDVISN,1,24),X,1,54)_$$SETSTR^SDMHPRO1(SDTOTS,X,1,24)
DO SET1^SDMHPRO1(SDX)
End DoDot:2
End DoDot:1
+16 SET X=""
SET SDX=""
SET SDX=$$SETSTR^SDMHPRO1(" ",X,1,80)
DO SET1^SDMHPRO1(SDX)
+17 SET X=""
SET SDX=""
+18 QUIT
TOTAL1 ;TOTALS FOR AD HOC
+1 if '$DATA(TOTAL)
QUIT
+2 NEW SDVISN,SDCLNIC,SDFLAG,SDX,X
+3 SET (SDVISN,SDCLNIC)=0
+4 WRITE ?25,"Division/Clinic Appointment Totals",!!
+5 WRITE "Division/CLinic",?50,"Unique",!
+6 WRITE ?49,"Patients",!!
+7 FOR
SET SDVISN=$ORDER(TOTAL(SDVISN))
if SDVISN']""
QUIT
Begin DoDot:1
+8 IF $DATA(TOTAL(SDVISN))
Begin DoDot:2
+9 NEW SDTOTS
+10 SET SDTOTS=$JUSTIFY($PIECE(TOTAL(SDVISN),"^",5),3)
+11 WRITE $EXTRACT(SDVISN,1,30),?50,SDTOTS,!
DO RET^SDMHAP1
if SDUP
QUIT
End DoDot:2
End DoDot:1
+12 WRITE !
DO RET^SDMHAP1
if SDUP
QUIT
+13 QUIT
COUNT ; COUNTER
+1 SET SDCOUNT=SDCOUNT+1
