Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDMHPRO

SDMHPRO.m

Go to the documentation of this file.
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
 ;
 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