source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSSR1.m@ 623

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1YSSR1 ;SLC/AFE-SECLUSION/RESTRAINT - Observation,Release & Review ; 1/27/04 11:17am
2 ;;5.01;MENTAL HEALTH;**82**;Dec 30, 1994;Build 3
3ENRLS ; Called from MENU option YSSR RELEASE
4 ;
5 ; Release of patient from S/R episode.
6 W @IOF,!?IOM-$L("RELEASE FROM SECLUSION/RESTRAINT")\2,"RELEASE FROM SECLUSION/RESTRAINT",! S OPT=1,MSG1="No patients listed as requiring release."
7 D LKUP^YSSR I '$D(A1) D END^YSSR Q
8 D ^YSLRP I YSDFN'>0 D END^YSSR Q
9 S DIC="^YS(615.2,",DIC(0)="X",D="AC",X=YSDFN D IX^DIC S B=+Y I B<1 W $C(7),!!,"Patient not listed as in Seclusion/Restraint." D END^YSSR Q
10 I $D(^YS(615.2,B,40)) S Y=+$P($G(^(40)),U,3) D DD^%DT W !!,$C(7),YSN," shown as released ",Y D END^YSSR Q
11 W ! S DIE="^YS(615.2,",DA=B,DR="40:41;42//NOW" K Y L +^YS(615.2,DA) D ^DIE L -^YS(615.2,DA) S YSTOUT=$D(DTOUT),YSUOUT=$O(Y(""))]""
12 I YSTOUT!YSUOUT K ^YS(615.2,B,40) W !!?10,"< RELEASE DELETED >" D END^YSSR Q
13 S DR="43///^S X=""`""_DUZ;44///NOW;45" L +^YS(615.2,DA) D ^DIE L -^YS(615.2,DA) W !!?10,"PATIENT NOTED AS RELEASED."
14 D END^YSSR
15 Q
16ENREV ; Called from MENU option YSSR REVIEW
17 ; Review of S/R action.
18 W @IOF,!?IOM-$L("REVIEW OF SECLUSION/RESTRAINT ASSESSMENT")\2,"REVIEW OF SECLUSION/RESTRAINT ASSESSMENT",!
19REV ;
20 I '$O(^YS(615.2,"AD",0)) W !!,"No review action required." D END^YSSR Q
21 S RVN=0,QRVN=1 W !,"The following S/R actions have not been reviewed: ",! S B=0 F S B=$O(^YS(615.2,"AD",B)) Q:'B S B1=0 F S B1=$O(^YS(615.2,"AD",B,B1)) Q:'B1 S RVN=RVN+1,RVP(RVN)=B1 D REVLST
22ASK ;
23 W !!,"Select action for review: ",QRVN,"// " R A1:DTIME S YSTOUT='$T,YSUOUT=A1["^" Q:YSTOUT!YSUOUT S:A1="" A1=QRVN I A1'?.N S A1=0
24 I A1<1!(A1>RVN) W !!,$C(7),"Not valid - re-enter." K A1 G ASK
25 W @IOF S (DA,FN)=RVP(A1),DIC="^YS(615.2," D EN^DIQ W !,"**********"
26 S DIE="^YS(615.2,",DA=FN,DR="50;51//A;52//NOW" L +^YS(615.2,DA) D ^DIE L -^YS(615.2,DA) S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
27 I YSTOUT!YSUOUT!($O(Y(""))]"") K ^YS(615.2,FN,50),DA,DIE,DR W !!?10,"< REVIEW ACTION DELETED >" D END^YSSR Q
28 S DR="53///^S X=""`""_DUZ;54///NOW;55" L +^YS(615.2,DA) D ^DIE W !!?10,"REVIEW ACTION NOTED." L -^YS(615.2,DA) K DA,DIE,DR
29 I '$D(^YS(615.2,"AD")) W !,"No other review action required." D END^YSSR Q
30 G REV
31 ;
32REVLST ;
33 S RVNM=$P(^DPT(B,0),U),Y=$P(^YS(615.2,B1,0),U,3) D DD^%DT W !?3,RVN,?8,$P(RVNM,",",2)_" "_$P(RVNM,",",1),?40,Y
34 Q
35 ;
36ENCK ; Called from MENU option YSSR 15-CHECK
37 ; Observation of patient in S/R.
38 S YSB=0 D LKUP^YSSR G:'$D(A1) END^YSSR
39 D ^YSLRP I YSDFN'>0 D END^YSSR Q
40 S YSB=$O(^YS(615.2,"AC",YSDFN,YSB)) Q:'YSB I '$D(^YS(615.2,YSB,60)) S ^YS(615.2,YSB,60,0)="^615.3DA^^"
41 S DIC="^YS(615.2,YSB,60,",DIC(0)="AMELQ",DLAYGO=615,DIC("B")="NOW",DA(1)=YSB D ^DIC K DIC("B") I Y<1 D END^YSSR Q
42 S DIE=DIC,DA=+Y,DR="1;4" L +^YS(615.2,YSB) D ^DIE L -^YS(615.2,YSB) S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
43 I YSTOUT!YSUOUT!('$P($G(^YS(615.2,DA(1),60,DA,0)),U,2))!('$O(^YS(615.2,DA(1),60,DA,60,0))) S DIK=DIE D ^DIK W !!?10,"< OBSERVATION DELETED >" D END^YSSR Q
44 S DR="2///^S X=""`""_DUZ;3///NOW" L +^YS(615.2,YSB) D ^DIE W !!?15,"OBSERVATION NOTED." L -^YS(615.2,YSB)
45 D END^YSSR
46 Q
47ENWO ; Called from MENU option YSSR W-ORDER
48 ; Entry/edit of Type of S/R Order
49 W @IOF,!?IOM-$L("EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER")\2,"EDIT OF TYPE OF SECLUSION/RESTRAINT ORDER",!
50 W !,"SECLUSION/RESTRAINT EPISODES REQUIRING WRITTEN ORDERS: ",!
51 D HEADER^YSSR S A=0 F S A=$O(^YS(615.2,"AF",A)) Q:'A S A1=0 F S A1=$O(^YS(615.2,"AF",A,A1)) Q:'A1 D PNAMES^YSSR S YSWN=1,YSA1=A1
52 I '$D(YSWN) W !!,"No patients listed as requiring a written order.",! D END^YSSR Q
53 I $D(YS02) W !!," * Written Order Required.",!
54 I $D(YS04) W:'$D(YS02) !! W " # Record incomplete, please contact IRM.",!
55 K YS02,YS04
56 D ^YSLRP I YSDFN'>0 D END^YSSR Q
57WOLKUP ;
58 S YSA1=$O(^YS(615.2,"AF",YSDFN,0)) I 'YSA1 W !!,"Written order not required for this patient.",! D END^YSSR Q
59 S DIE="^YS(615.2,",DA=YSA1,DR="25:27;28///NOW" L +^YS(615.2,YSA1) D ^DIE L -^YS(615.2,YSA1)
60 I $P(^YS(615.2,YSA1,25),U,2)="w" K ^YS(615.2,"AF",YSDFN,YSA1)
61 D END^YSSR Q
Note: See TracBrowser for help on using the repository browser.