- 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 Apr 23, 2025@19:13:19 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
