source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSSRU.m@ 1397

YSSRU ;SLC/DJP-Utilities for YS Seclusion/Restraint Reports ;6/4/90  11:35 ;
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
 ;
YSMGT ; Called from MENU option YSSR 10-2683
 ;
 W @IOF,!!?5,"MONTHLY REPORT OF RESTRAINT AND SECLUSION (VA Form 10-2683)",! D WARN,SETUP I YSTOUT!YSUOUT G KILL
 S DIC="^YS(615.2,",FLDS="[YSSR 10-2683 PRINT]",BY="[YSSR 10-2683 SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)"
 ;S DIOBEG="I IOM'=132 W !!,""THIS REPORT MUST BE SENT TO A PRINTER WHICH ACCEPTS A 132-CHARACTER LINE."",! K DIOBEG Q" G YSDIP
 G YSDIP
 ;
YSREV ; Called from MENU option YSSR REVIEW RPT
 ;
 W @IOF,!!?IOM-$L("REVIEW OF SECLUSION/RESTRAINT ACTION REPORT")\2,"REVIEW OF SECLUSION/RESTRAINT ACTION REPORT",! D SETUP I YSTOUT!YSUOUT G KILL
 S DIC="^YS(615.2,",FLDS="[YSSR REVIEW ACTION PRINT]",BY="[YSSR DATE OF REVIEW]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,50)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
 ;
YSDATE ; Called from MENU option YSSR MGTRD
 ;
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY DATE")\2,"S/R MANAGEMENT REPORT BY DATE",! D SETUP I YSTOUT!YSUOUT G KILL
 S DIC="^YS(615.2,",FLDS="[YSSR DATE MGT PRINT]",BY="[YSSR DATE SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
 ;
YSWARD ; Called from MENU option YSSR MGTRW
 ;
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY WARD")\2,"S/R MANAGEMENT REPORT BY WARD",! D SETUP I YSUOUT!YSTOUT G KILL
 S DIC="^YS(615.2,",FLDS="[YSSR WARD MGT PRINT]",BY="[YSSR WARD MGT SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
 ;
YSNURSE ; Called from MENU option YSSR MGTRN
 ;
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY NURSING SHIFT")\2,"S/R MANAGEMENT REPORT BY NURSING SHIFT",! D SETUP I YSUOUT!YSTOUT G KILL
 S DIC="^YS(615.2,",FLDS="[YSSR NURSE MGT PRINT]",BY="[YSSR NURSE MGT SORT]",DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)" G YSDIP
 ;
YSINQ ; Called from MENU option YSSR MGTRI
 ;
 W @IOF,!!?IOM-$L("S/R MANAGEMENT REPORT BY PATIENT EPISODE")\2,"S/R MANAGEMENT REPORT BY PATIENT EPISODE",! D INIT
 S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615,D="C",DIC("A")="Select PATIENT NAME:  " D IX^DIC K DIC("A") G:+Y<0 KILL S YSI=$P(^YS(615.2,+Y,0),U)
 S DIC="^YS(615.2,",FLDS="[YSSR PT INQ PRINT]",BY="@FILE ENTRY DATE",FR=YSI,TO=YSI,DIS(0)="I YSI=$P(^YS(615.2,D0,0),U)" G YSDIP
YSDIP ;
 I $D(YSQT) D KILL Q
 S:'$D(DIOBEG) DIOEND="I YSSRCTR<1 W !!?20,""*** NO REPORT FOUND ***"",!" S L=0 D EN1^DIP
 W ! D WAIT^YSUTL
KILL ;
 K DIOBEG,YSEND,YSM,YSH,YSMIN,YSTIME,YSLCN,YSQT,YSVAR,BY,FLDS,DIC,FR,TO,YSSRCTR,DIOEND,L1,L2,YSDIPA,YSE,YSY,YSB,YSCLN,YSSRCTR
 Q
SETUP ;
 D INIT,BEGDT S YSUOUT=Y'>0 Q:YSTOUT!YSUOUT  S YSB=Y_".000001"
 D ENDDT S YSUOUT=Y'>0 Q:YSTOUT!YSUOUT  S YSE=Y_".235959"
 S X=YSB,YSB=$S(YSB>YSE:YSE,1:YSB),YSE=$S(YSE>X:YSE,1:X)
 S Y=YSE D DD^%DT S YSDIPA("YSEND")=Y S Y=YSB D DD^%DT S YSDIPA("YSBEG")=Y
 Q
BEGDT ;
 W !! S %DT="AE",%DT("A")="BEGINNING DATE: ",%DT(0)="-NOW" D ^%DT K %DT
 S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)!(Y'>0) Q
ENDDT ;
 S %DT="AE",%DT("A")="ENDING DATE: ",%DT("B")="TODAY",%DT(0)="-NOW" D ^%DT K %DT
 S YSTOUT=$G(DTOUT),YSUOUT=$D(DUOUT)!(Y'>0) Q
INIT ;
 S (YSLCN,YSVAR,YSSRCTR)=0
SITE ;
 S YSLCN=$$SITE^YSFORM,YSDIPA("YSLCN")="VAMC "_YSLCN Q
HEADER ;
 S $P(YSDIPA("HLN"),"=",133)="",YSDIPA("HLN2")=$E(YSDIPA("HLN"),1,80)
 Q
PARSE ;Sets variables for use within the print templates used by File ^YS(615.2) - SECLUSION/RESTRAINT
 K YSDIPA("YSRT"),YSDIPA("YSRT1"),YSDIPA("YSAT1"),YSDIPA("YSTT"),YSDIPA("YSAT") S R1=+$P($G(^YS(615.2,D0,0)),U,3),R2=+$P($G(^(40)),U,3),YSSRCTR=YSSRCTR+1
 I R1'=0 S YSDIPA("YSAT")=$P(R1,"."),Y=R1 D DD^%DT S YSDIPA("YSAT1")=$P(Y,"@",2)
 I R2'=0 S YSDIPA("YSRT")=$P(R2,"."),Y=R2 D DD^%DT S YSDIPA("YSRT1")=$P(Y,"@",2)
 I R2=0 S YSDIPA("YSRT")="*",YSDIPA("YSRT1")=" " K R1,R2 Q
 S YSVAR=$O(^DD("FUNC","B","MINUTES",0)) G:'YSVAR TRBL S X=R1,X1=R2 X ^DD("FUNC",YSVAR,1) S R3=X,YSH=X\60,R4=YSH*60,YSMIN=R3-R4,YSDIPA("YSTT")=YSH_":"_YSMIN
 K YSVAR,R1,R2,R3,R4,YSH,YSMIN Q
TRBL ;
 W !!,"SEE YOUR SITE MANAGER.  FUNCTION FILE PROBLEM." G KILL
WARN ;
 W !!,"WARNING - This report prints out in a 132 column format.",!,"DO NOT SEND TO A TERMINAL." Q