YSSR2 ;SLC/DJP,HIOFO/FT - SECLUSION/RESTRAINT - Management Utilities ;10/21/11 10:21am
;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
;
;Reference to ^DPT( supported by DBIA #10035
;
ENEDIT ; Called from MENU option YSSR EDIT
;
; Permits editing of Seclusion/Restraint Entry
S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615.2,D="C",DIC("A")="Select PATIENT NAME: " D IX^DIC K DIC("A"),D S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT D END^YSSR Q
I Y<0 W !?10,"Patient not shown on file." D END^YSSR Q
S DIE=DIC,DA=+Y,DR=".03:3;5:27;30"
L +^YS(615.2,DA):DILOCKTM
I '$T D ERRMSG^YSSITE,END^YSSR Q
D ^DIE
L -^YS(615.2,DA)
S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
I YSTOUT!YSUOUT D END^YSSR Q
L +^YS(615.2,DA):DILOCKTM
I '$T D ERRMSG^YSSITE,END^YSSR Q
I $D(^YS(615.2,DA,40)) S DR="40:42;45" D ^DIE
I $D(^YS(615.2,DA,50)) S DR="50:52;55" D ^DIE
I $D(^YS(615.2,DA,60)) S DR=60 D ^DIE
L -^YS(615.2,DA) D END^YSSR
Q
;
ENTRYD ; Called from MENU option YSSR DELETE
;
; Permit deletion of an entire Seclusion/Restraint Entry.
S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615.2,D="C",DIC("A")="Select PATIENT NAME: " D IX^DIC K DIC("A"),D S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT D END^YSSR Q
I Y<0 W !?10,"Patient not shown on file." D END^YSSR Q
W @IOF S (FN,DA,YSDA)=+Y,DR=".01:60",S=0 D EN^DIQ
QUES ;
W !!,"Is this the entry you wish to delete" S %=2 D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT D END^YSSR Q
I %=0 W !!,"YES will remove the entry from the file. It will not be recoverable.",!,"NO will exit you from this option. Entry will remain on file.",! G QUES
I %=1 S W1=$P(^YS(615.2,DA,0),U,2),W2=^DPT(W1,0),(YSNM,W3)=$P(W2,U),FN=DA D DELETE^YSSR
D END^YSSR
Q
;
KILLALL ;This sub routine is an exit action to be called from the following
;'YSSR*' Seclusion/Restraint options.
K %DT,A,B,B1,D,D0,DIK,DIQ,DIS,DLAYGO,DTOUT,DUOUT,FN,JRBY,JRBYN,JRVAR
K K,L,MSG1,QRVN,RVN,RVNM,RVP,S,SSN,W1,W2,W3,X1,XQY
K YS02,YSA1,YSDA,YSDFN,YSDX,YSI,YSN,YSNM,YSWN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSSR2 2054 printed Oct 16, 2024@18:15:40 Page 2
YSSR2 ;SLC/DJP,HIOFO/FT - SECLUSION/RESTRAINT - Management Utilities ;10/21/11 10:21am
+1 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
+2 ;
+3 ;Reference to ^DPT( supported by DBIA #10035
+4 ;
ENEDIT ; Called from MENU option YSSR EDIT
+1 ;
+2 ; Permits editing of Seclusion/Restraint Entry
+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"),D
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
IF YSTOUT!YSUOUT
DO END^YSSR
QUIT
+4 IF Y<0
WRITE !?10,"Patient not shown on file."
DO END^YSSR
QUIT
+5 SET DIE=DIC
SET DA=+Y
SET DR=".03:3;5:27;30"
+6 LOCK +^YS(615.2,DA):DILOCKTM
+7 IF '$TEST
DO ERRMSG^YSSITE
DO END^YSSR
QUIT
+8 DO ^DIE
+9 LOCK -^YS(615.2,DA)
+10 SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
+11 IF YSTOUT!YSUOUT
DO END^YSSR
QUIT
+12 LOCK +^YS(615.2,DA):DILOCKTM
+13 IF '$TEST
DO ERRMSG^YSSITE
DO END^YSSR
QUIT
+14 IF $DATA(^YS(615.2,DA,40))
SET DR="40:42;45"
DO ^DIE
+15 IF $DATA(^YS(615.2,DA,50))
SET DR="50:52;55"
DO ^DIE
+16 IF $DATA(^YS(615.2,DA,60))
SET DR=60
DO ^DIE
+17 LOCK -^YS(615.2,DA)
DO END^YSSR
+18 QUIT
+19 ;
ENTRYD ; Called from MENU option YSSR DELETE
+1 ;
+2 ; Permit deletion of an entire Seclusion/Restraint Entry.
+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"),D
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
IF YSTOUT!YSUOUT
DO END^YSSR
QUIT
+4 IF Y<0
WRITE !?10,"Patient not shown on file."
DO END^YSSR
QUIT
+5 WRITE @IOF
SET (FN,DA,YSDA)=+Y
SET DR=".01:60"
SET S=0
DO EN^DIQ
QUES ;
+1 WRITE !!,"Is this the entry you wish to delete"
SET %=2
DO YN^DICN
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
IF YSTOUT!YSUOUT
DO END^YSSR
QUIT
+2 IF %=0
WRITE !!,"YES will remove the entry from the file. It will not be recoverable.",!,"NO will exit you from this option. Entry will remain on file.",!
GOTO QUES
+3 IF %=1
SET W1=$PIECE(^YS(615.2,DA,0),U,2)
SET W2=^DPT(W1,0)
SET (YSNM,W3)=$PIECE(W2,U)
SET FN=DA
DO DELETE^YSSR
+4 DO END^YSSR
+5 QUIT
+6 ;
KILLALL ;This sub routine is an exit action to be called from the following
+1 ;'YSSR*' Seclusion/Restraint options.
+2 KILL %DT,A,B,B1,D,D0,DIK,DIQ,DIS,DLAYGO,DTOUT,DUOUT,FN,JRBY,JRBYN,JRVAR
+3 KILL K,L,MSG1,QRVN,RVN,RVNM,RVP,S,SSN,W1,W2,W3,X1,XQY
+4 KILL YS02,YSA1,YSDA,YSDFN,YSDX,YSI,YSN,YSNM,YSWN
+5 QUIT
