source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSSR2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1YSSR2 ;SLC/DJP-SECLUSION/RESTRAINT - Management Utilities ; 10/18/88 17:40 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4ENEDIT ; Called from MENU option YSSR EDIT
5 ;
6 ; Permits editing of Seclusion/Restraint Entry
7 S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615,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
8 I Y<0 W !?10,"Patient not shown on file." D END^YSSR Q
9 S DIE=DIC,DA=+Y,DR=".03:3;5:27;30" L +^YS(615.2,DA) D ^DIE L -^YS(615.2,DA) S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT D END^YSSR Q
10 L +^YS(615.2,DA)
11 I $D(^YS(615.2,DA,40)) S DR="40:42;45" D ^DIE
12 I $D(^YS(615.2,DA,50)) S DR="50:52;55" D ^DIE
13 I $D(^YS(615.2,DA,60)) S DR=60 D ^DIE
14 L -^YS(615.2,DA) D END^YSSR
15 Q
16 ;
17ENTRYD ; Called from MENU option YSSR DELETE
18 ;
19 ; Permit deletion of an entire Seclusion/Restraint Entry.
20 S DIC="^YS(615.2,",DIC(0)="AEQLM",DLAYGO=615,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
21 I Y<0 W !?10,"Patient not shown on file." D END^YSSR Q
22 W @IOF S (FN,DA,YSDA)=+Y,DR=".01:60",S=0 D EN^DIQ
23QUES ;
24 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
25 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
26 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
27 D END^YSSR
28 Q
29 ;
30KILLALL ;This sub routine is an exit action to be called from the following
31 ;'YSSR*' Seclusion/Restraint options.
32 K %DT,A,B,B1,D,D0,DIK,DIQ,DIS,DLAYGO,DTOUT,DUOUT,FN,JRBY,JRBYN,JRVAR
33 K K,L,MSG1,QRVN,RVN,RVNM,RVP,S,SSN,W1,W2,W3,X1,XQY
34 K YS02,YSA1,YSDA,YSDFN,YSDX,YSI,YSN,YSNM,YSWN
35 QUIT
36 ;
37EOR ;YSSR2 - SECLUSION/RESTRAINT - Management Utilities ; 10/18/88 17:40 ;
Note: See TracBrowser for help on using the repository browser.