YSSRU ;SLC/DJP,HIOFO/FT - Utilities for YS Seclusion/Restraint Reports ;10/20/11 16:14
;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
;
;No external references
;
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)"
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.2,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
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 X=R1,X1=R2
;next 2 lines are FileMan MINUTES function code
S Y=$E(X1_"000",9,10)-$E(X_"000",9,10)*60+$E(X1_"00000",11,12)-$E(X_"00000",11,12),X2=X,X=$P(X,".",1)'=$P(X1,".",1)
D ^%DTC:X S X=X*1440+Y
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
WARN ;
W !!,"WARNING - This report prints out in a 132 column format.",!,"DO NOT SEND TO A TERMINAL."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSSRU 4196 printed Nov 22, 2024@17:25 Page 2
YSSRU ;SLC/DJP,HIOFO/FT - Utilities for YS Seclusion/Restraint Reports ;10/20/11 16:14
+1 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
+2 ;
+3 ;No external references
+4 ;
YSMGT ; Called from MENU option YSSR 10-2683
+1 ;
+2 WRITE @IOF,!!?5,"MONTHLY REPORT OF RESTRAINT AND SECLUSION (VA Form 10-2683)",!
DO WARN
DO SETUP
IF YSTOUT!YSUOUT
GOTO KILL
+3 SET DIC="^YS(615.2,"
SET FLDS="[YSSR 10-2683 PRINT]"
SET BY="[YSSR 10-2683 SORT]"
SET DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)"
+4 GOTO YSDIP
+5 ;
YSREV ; Called from MENU option YSSR REVIEW RPT
+1 ;
+2 WRITE @IOF,!!?IOM-$LENGTH("REVIEW OF SECLUSION/RESTRAINT ACTION REPORT")\2,"REVIEW OF SECLUSION/RESTRAINT ACTION REPORT",!
DO SETUP
IF YSTOUT!YSUOUT
GOTO KILL
+3 SET DIC="^YS(615.2,"
SET FLDS="[YSSR REVIEW ACTION PRINT]"
SET BY="[YSSR DATE OF REVIEW]"
SET DIS(0)="S YSY=+$P($G(^YS(615.2,D0,50)),U,3) I (YSY'<YSB),(YSY'>YSE)"
GOTO YSDIP
+4 ;
YSDATE ; Called from MENU option YSSR MGTRD
+1 ;
+2 WRITE @IOF,!!?IOM-$LENGTH("S/R MANAGEMENT REPORT BY DATE")\2,"S/R MANAGEMENT REPORT BY DATE",!
DO SETUP
IF YSTOUT!YSUOUT
GOTO KILL
+3 SET DIC="^YS(615.2,"
SET FLDS="[YSSR DATE MGT PRINT]"
SET BY="[YSSR DATE SORT]"
SET DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)"
GOTO YSDIP
+4 ;
YSWARD ; Called from MENU option YSSR MGTRW
+1 ;
+2 WRITE @IOF,!!?IOM-$LENGTH("S/R MANAGEMENT REPORT BY WARD")\2,"S/R MANAGEMENT REPORT BY WARD",!
DO SETUP
IF YSUOUT!YSTOUT
GOTO KILL
+3 SET DIC="^YS(615.2,"
SET FLDS="[YSSR WARD MGT PRINT]"
SET BY="[YSSR WARD MGT SORT]"
SET DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)"
GOTO YSDIP
+4 ;
YSNURSE ; Called from MENU option YSSR MGTRN
+1 ;
+2 WRITE @IOF,!!?IOM-$LENGTH("S/R MANAGEMENT REPORT BY NURSING SHIFT")\2,"S/R MANAGEMENT REPORT BY NURSING SHIFT",!
DO SETUP
IF YSUOUT!YSTOUT
GOTO KILL
+3 SET DIC="^YS(615.2,"
SET FLDS="[YSSR NURSE MGT PRINT]"
SET BY="[YSSR NURSE MGT SORT]"
SET DIS(0)="S YSY=+$P($G(^YS(615.2,D0,0)),U,3) I (YSY'<YSB),(YSY'>YSE)"
GOTO YSDIP
+4 ;
YSINQ ; Called from MENU option YSSR MGTRI
+1 ;
+2 WRITE @IOF,!!?IOM-$LENGTH("S/R MANAGEMENT REPORT BY PATIENT EPISODE")\2,"S/R MANAGEMENT REPORT BY PATIENT EPISODE",!
DO INIT
+3 SET DIC="^YS(615.2,"
SET DIC(0)="AEQLM"
SET DLAYGO=615.2
SET D="C"
SET DIC("A")="Select PATIENT NAME: "
DO IX^DIC
KILL DIC("A")
if +Y<0
GOTO KILL
SET YSI=$PIECE(^YS(615.2,+Y,0),U)
+4 SET DIC="^YS(615.2,"
SET FLDS="[YSSR PT INQ PRINT]"
SET BY="@FILE ENTRY DATE"
SET FR=YSI
SET TO=YSI
SET DIS(0)="I YSI=$P(^YS(615.2,D0,0),U)"
GOTO YSDIP
YSDIP ;
+1 IF $DATA(YSQT)
DO KILL
QUIT
+2 if '$DATA(DIOBEG)
SET DIOEND="I YSSRCTR<1 W !!?20,""*** NO REPORT FOUND ***"",!"
SET L=0
DO EN1^DIP
+3 WRITE !
DO WAIT^YSUTL
KILL ;
+1 KILL DIOBEG,YSEND,YSM,YSH,YSMIN,YSTIME,YSLCN,YSQT,YSVAR,BY,FLDS,DIC,FR,TO,YSSRCTR,DIOEND,L1,L2,YSDIPA,YSE,YSY,YSB,YSCLN,YSSRCTR
+2 QUIT
SETUP ;
+1 DO INIT
DO BEGDT
SET YSUOUT=Y'>0
if YSTOUT!YSUOUT
QUIT
SET YSB=Y_".000001"
+2 DO ENDDT
SET YSUOUT=Y'>0
if YSTOUT!YSUOUT
QUIT
SET YSE=Y_".235959"
+3 SET X=YSB
SET YSB=$SELECT(YSB>YSE:YSE,1:YSB)
SET YSE=$SELECT(YSE>X:YSE,1:X)
+4 SET Y=YSE
DO DD^%DT
SET YSDIPA("YSEND")=Y
SET Y=YSB
DO DD^%DT
SET YSDIPA("YSBEG")=Y
+5 QUIT
BEGDT ;
+1 WRITE !!
SET %DT="AE"
SET %DT("A")="BEGINNING DATE: "
SET %DT(0)="-NOW"
DO ^%DT
KILL %DT
+2 SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)!(Y'>0)
QUIT
ENDDT ;
+1 SET %DT="AE"
SET %DT("A")="ENDING DATE: "
SET %DT("B")="TODAY"
SET %DT(0)="-NOW"
DO ^%DT
KILL %DT
+2 SET YSTOUT=$GET(DTOUT)
SET YSUOUT=$DATA(DUOUT)!(Y'>0)
QUIT
INIT ;
+1 SET (YSLCN,YSVAR,YSSRCTR)=0
SITE ;
+1 SET YSLCN=$$SITE^YSFORM
SET YSDIPA("YSLCN")="VAMC "_YSLCN
QUIT
+1 SET $PIECE(YSDIPA("HLN"),"=",133)=""
SET YSDIPA("HLN2")=$EXTRACT(YSDIPA("HLN"),1,80)
+2 QUIT
PARSE ;Sets variables for use within the print templates used by File ^YS(615.2) - SECLUSION/RESTRAINT
+1 KILL YSDIPA("YSRT"),YSDIPA("YSRT1"),YSDIPA("YSAT1"),YSDIPA("YSTT"),YSDIPA("YSAT")
SET R1=+$PIECE($GET(^YS(615.2,D0,0)),U,3)
SET R2=+$PIECE($GET(^(40)),U,3)
SET YSSRCTR=YSSRCTR+1
+2 IF R1'=0
SET YSDIPA("YSAT")=$PIECE(R1,".")
SET Y=R1
DO DD^%DT
SET YSDIPA("YSAT1")=$PIECE(Y,"@",2)
+3 IF R2'=0
SET YSDIPA("YSRT")=$PIECE(R2,".")
SET Y=R2
DO DD^%DT
SET YSDIPA("YSRT1")=$PIECE(Y,"@",2)
+4 IF R2=0
SET YSDIPA("YSRT")="*"
SET YSDIPA("YSRT1")=" "
KILL R1,R2
QUIT
+5 SET X=R1
SET X1=R2
+6 ;next 2 lines are FileMan MINUTES function code
+7 SET Y=$EXTRACT(X1_"000",9,10)-$EXTRACT(X_"000",9,10)*60+$EXTRACT(X1_"00000",11,12)-$EXTRACT(X_"00000",11,12)
SET X2=X
SET X=$PIECE(X,".",1)'=$PIECE(X1,".",1)
+8 if X
DO ^%DTC
SET X=X*1440+Y
+9 SET R3=X
SET YSH=X\60
SET R4=YSH*60
SET YSMIN=R3-R4
SET YSDIPA("YSTT")=YSH_":"_YSMIN
+10 KILL YSVAR,R1,R2,R3,R4,YSH,YSMIN
+11 QUIT
WARN ;
+1 WRITE !!,"WARNING - This report prints out in a 132 column format.",!,"DO NOT SEND TO A TERMINAL."
+2 QUIT
