source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURCUT0.m@ 1351

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1NURCUT0 ;HIRMFO/MD,RM,FT-PATIENT SELECTION UTILITY BY WARD, ROOM OR SINGLE PATIENT ;7/24/97
2 ;;4.0;NURSING SERVICE;**2,7,21**;Apr 25, 1997
3WARDPAT ; SELECT ASSIGNMENT SHEET BY 1. WHOLE WARD, 2. SELECTED ROOMS ON WARD, 3. PATIENT
4 S (NUROUT,NURQUIT)=0 W !,"By (U)nit, (S)elected unit rooms, or (P)atient? " R NUREDB:DTIME I "^"[NUREDB!('$T) S (NUROUT,NURQUIT)=1 Q
5 S:NUREDB?1L NUREDB=$C($A(NUREDB)-32) I "Uu"[NUREDB!("Ss"[NUREDB)!("Pp"[NUREDB) G WP1
6 I NUREDB?1"?".E G WARDPAT
7 W !,$C(7),?5,"INVALID ENTRY ??" G WARDPAT
8WP1 ;
9 I "Uu"[NUREDB!("Ss"[NUREDB) D WARDSEL Q:NURQUIT G WARDPAT:$G(NORM),QUIT
10 D PATDAT I +Y'>0 W ! G WARDPAT
11 G QUIT
12WARDSEL ; SELECT WARD TO BE SEARCHED
13 W ! S NORM=0,DIC="^NURSF(211.4,",DIC(0)="AEQMZ",DIC("S")="I $S('$D(^NURSF(211.4,""D"",""I"",+Y)):1,$P(^NURSF(211.4,+Y,1),U,1)=""I"":0,1:1)"
14 S DIC("A")="Select Unit: "
15 D ^DIC K DIC I X="^"!(+Y'>0) S:$D(NURLOCSW) NURQUIT=1 Q:NURQUIT=1 W ! G WARDPAT
16 W ! S (NURWARD,NPWARD)=+Y,DFN=$O(^NURSF(214,"E",NURWARD,0)) D EN6^NURSAUTL
17 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON WARD
18 I DFN="" W !,$C(7),"**** NO PATIENTS REGISTERED ON UNIT ",NPWARD," ****" S NURQUIT=1 Q
19 Q:"Uu"[NUREDB
20 K NRM F NDA=0:0 S NDA=$O(^NURSF(211.4,+Y,3,NDA)) Q:NDA'>0 S NWLOC=$P(^NURSF(211.4,+Y,3,NDA,0),"^") D RMST
21 K NMRC S NURSY="" F NURSX=1:1 S NURSY=$O(NRM(NURSY)) Q:NURSY="" S NMRC(NURSX)=NURSY
22 K NRM S NORM=$S($O(NMRC(""))'="":0,1:1) W:NORM !,$C(7),"NO ROOMS ON THIS UNIT",! Q:NORM D EN3 S NORM=$S($O(NRMBD(""))'="":0,1:1) W:NORM&('NURQUIT) !!,$C(7),"NO ROOMS SELECTED CANNOT RUN THIS REPORT.",! K NMRC
23 Q
24RMST ;
25 I $D(^DG(405.4,0)) F ND1=0:0 S ND1=$O(^DG(405.4,"W",NWLOC,ND1)) Q:ND1'>0 S NRM=$S($D(^DG(405.4,ND1,0)):$P($P(^(0),"^"),"-",1,2),1:"") I NRM'="" S NRM(NRM)=""
26 Q
27PATDAT ; SINGLE PATIENT SELECTION
28 S:'$D(NACT) NACT=1
29 S DIC(0)="EQMZ",NASK=1 D EN7^NURSCUTL I DFN'>0 S NURQUIT=1 Q
30 S DFN=+Y
31 Q
32EN3 ; SELECT ROOMS ON A GIVEN WARD
33 K NURP,NRMBD S NURP(1)=1,NURP(2)=21,NURP(3)=41,NURP(4)=61,NURP(5)=81 W !,"Unit "_NPWARD_" has the following rooms:",! F NURSX=0:0 S NURSX=$O(NMRC(NURSX)) Q:NURSX'<21!'(NURSX>0) D
34 . W ! W:$G(NMRC($G(NURP(1))))'="" NURP(1),". ",?6,$G(NMRC(NURP(1))) W:$G(NMRC($G(NURP(2))))'="" ?16,NURP(2),". ",$G(NMRC(NURP(2))) W:$G(NMRC($G(NURP(3))))'="" ?33,NURP(3),". ",$G(NMRC(NURP(3)))
35 . W:$G(NMRC($G(NURP(4))))'="" ?49,NURP(4),". ",$G(NMRC(NURP(4))) W:$G(NMRC($G(NURP(5))))'="" ?65,NURP(5),". ",$G(NMRC(NURP(5)))
36 . S NURP(1)=(NURP(1)+1),NURP(2)=(NURP(2)+1),NURP(3)=(NURP(3)+1),NURP(4)=(NURP(4)+1),NURP(5)=(NURP(5)+1)
37 . Q
38 W !!,"Select the NUMBER(S) of the rooms: "
39 R NURRMST:DTIME S:'$T NURRMST="^" I "^"[NURRMST S:NURRMST["^" NURQUIT=1 Q
40 W ! I NURRMST?1"?".E W !,?5,"Type in number(s) associated with the rooms you want,",!,?5,"separated by commas or hyphens if there is more than one room",!,?5,"(e.g., 1-3,5 would be entries 1,2,3 and 5)." G EN3
41 I '(NURRMST?.N!(NURRMST?.NP&(NURRMST["-"!(NURRMST[",")))) W $C(7)," ??" G EN3
42 F NURI=1:1 S NURLEN=$P(NURRMST,",",NURI) Q:NURLEN="" S NURLEN(1)=$P(NURLEN,"-",2)_"+"_NURLEN F NURX=+NURLEN:1:+NURLEN(1) S:'$D(NMRC(NURX)) NURQUIT=1 S:$D(NMRC(NURX)) NRMBD(NMRC(NURX))=""
43 I NURQUIT S NURQUIT=0 G EN3
44 Q
45QUIT ;
46 K NURP,NDA,ND1,NWLOC,NURSY,NURSX,NURRMST,NURI,NURLEN,NORM,NMRC,NURX,NACT,NASK,RMSEL,X,Y
47 Q
Note: See TracBrowser for help on using the repository browser.