source: WorldVistAEHR/trunk/r/GEN_MED_REC_IO-GMRY/GMRYUT4.m@ 808

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1GMRYUT4 ;HIRMFO/YH,RM-PATIENT SELECTION BY UNIT, ROOM OR SINGLE PATIENT ;11/7/95
2 ;;4.0;Intake/Output;;Apr 25, 1997
3WARDPAT ; SELECT ASSIGNMENT SHEET BY 1. WHOLE UNIT, 2. SELECTED ROOMS ON UNIT, 3. PATIENT
4 W !,"By (U)nit, (S)elected unit rooms, or (P)atient? " R GMREDB:DTIME I "^"[GMREDB!('$T)!(GMREDB="") S GMROUT=1 Q
5 S:GMREDB?1L GMREDB=$C($A(GMREDB)-32) S:"Uu"[GMREDB GMREDB="W" I "Ww"[GMREDB!("Ss"[GMREDB)!("Pp"[GMREDB) G WP1
6 I GMREDB?1"?".E G WARDPAT
7 W !,$C(7),?5,"INVALID ENTRY ??" G WARDPAT
8WP1 ;
9 I "Ww"[GMREDB!("Ss"[GMREDB) D WARDSEL G:GMROUT QUIT G WARDPAT:GNORM,QUIT
10 D PATDAT G QUIT
11WARDSEL ; SELECT UNIT TO BE SEARCHED
12 I '$D(^NURSF(211.4)) S GMROUT=1 Q
13 W ! S GNORM=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 D ^DIC K DIC I X="^"!(+Y'>0) S GMROUT=1 Q
15 W ! S GMRWARD=+Y,DFN=$O(^NURSF(214,"E",GMRWARD,0)),GMRWARD(1)=$S(GMRWARD'>0:"",'$D(^NURSF(211.4,GMRWARD,0)):"",$P(^(0),"^")="":"",$D(^SC($P(^NURSF(211.4,GMRWARD,0),"^"),0)):$P(^(0),"^"),1:"")
16 S GMRWARD(1)=$S(GMRWARD(1)?1"NUR ".E:$P(GMRWARD(1),"NUR ",2),1:GMRWARD(1))
17 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON UNIT
18 I DFN="" W !,$C(7),"**** NO PATIENTS REGISTERED ON WARD ",GMRWARD(1)," ****" S GMROUT=1 Q
19 Q:"Ww"[GMREDB
20 K GNRM F GNDA=0:0 S GNDA=$O(^NURSF(211.4,+Y,3,GNDA)) Q:GNDA'>0 S GNWLOC=$P(^NURSF(211.4,+Y,3,GNDA,0),"^") D RMST
21 K GNMRC S GNURSY="" F GNURSX=1:1 S GNURSY=$O(GNRM(GNURSY)) Q:GNURSY="" S GNMRC(GNURSX)=GNURSY
22 K GNRM S GNORM=$S($O(GNMRC(""))'="":0,1:1) W:GNORM !,$C(7),"NO ROOMS ON THIS UNIT",! Q:GNORM D EN3 S GNORM=$S($O(GNRMBD(""))'="":0,1:1) W:GNORM&('GMROUT) !!,$C(7),"NO ROOMS SELECTED CANNOT RUN THIS REPORT.",! K GNMRC
23 Q
24RMST ;
25 I $D(^DG(405.4,0)) F GND1=0:0 S GND1=$O(^DG(405.4,"W",GNWLOC,GND1)) Q:GND1'>0 S GNRM=$S($D(^DG(405.4,GND1,0)):$P($P(^(0),"^"),"-"),1:"") I GNRM'="" S GNRM(GNRM)=""
26 Q
27PATDAT ; SINGLE PATIENT SELECTION
28 D PATDAT^GMRYUT0
29 Q
30EN3 ; SELECT ROOMS ON A GIVEN UNIT
31 K I,GNRMBD S I(1)=1,I(2)=21,I(3)=41,I(4)=61,I(5)=71 W !,"Unit "_GMRWARD(1)_" has the following rooms:",! F GNURSX=0:0 S GNURSX=$O(GNMRC(GNURSX)) Q:GNURSX'<21!'(GNURSX>0) D
32 .W ! W:$G(GNMRC($G(I(1))))'="" I(1),". ",?6,$G(GNMRC(I(1))) W:$G(GNMRC($G(I(2))))'="" ?16,I(2),". ",$G(GNMRC(I(2))) W:$G(GNMRC($G(I(3))))'="" ?33,I(3),". ",$G(GNMRC(I(3)))
33 .W:$G(GNMRC($G(I(4))))'="" ?49,I(4),". ",$G(GNMRC(I(4))) W:$G(GNMRC($G(I(5))))'="" ?65,I(5),". ",$G(GNMRC(I(5)))
34 .S I(1)=(I(1)+1),I(2)=(I(2)+1),I(3)=(I(3)+1),I(4)=(I(4)+1),I(5)=(I(5)+1)
35 W !!,"Select the NUMBER(S) of the rooms: " R GNURRMST:DTIME S:'$T GNURRMST="^" I "^"[GNURRMST!(GNURRMST="") S GMROUT=1 Q
36 W ! I GNURRMST?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
37 I '(GNURRMST?.N!(GNURRMST?.NP&(GNURRMST["-"!(GNURRMST[",")))) W $C(7)," ??" G EN3
38 F GNURI=1:1 S GNURLEN=$P(GNURRMST,",",GNURI) Q:GNURLEN="" S GNURLEN(1)=$P(GNURLEN,"-",2)_"+"_GNURLEN F GNURX=+GNURLEN:1:+GNURLEN(1) S:'$D(GNMRC(GNURX)) GMROUT=1 S:$D(GNMRC(GNURX)) GNRMBD(GNMRC(GNURX))=""
39 I GMROUT S GMROUT=0 G EN3
40 Q
41QUIT ;
42 K GNDA,GND1,GNWLOC,GNURSY,GNURSX,GNURRMST,GNURI,GNURLEN,GNORM,GNMRC,GNURX,GRMSEL,X,Y
43 Q
44INACT42(GMWLOC) ; THIS PROCEDURE WILL CALL SUPPORTED ENTRY POINT WIN^DGPMDDCF
45 ; TO DETERMINE IF UNIT LOCATION (GMWLOC) IS INACTIVE.
46 N X,D0,DGPMOS
47 S D0=GMWLOC D WIN^DGPMDDCF
48 Q X
Note: See TracBrowser for help on using the repository browser.