- 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 Feb 18, 2025@23:41:15 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
