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

GMRYUT4 ;HIRMFO/YH,RM-PATIENT SELECTION BY UNIT, ROOM OR SINGLE PATIENT ;11/7/95
 ;;4.0;Intake/Output;;Apr 25, 1997
WARDPAT ; SELECT ASSIGNMENT SHEET BY 1. WHOLE UNIT, 2. SELECTED ROOMS ON UNIT, 3. PATIENT
 W !,"By (U)nit, (S)elected unit rooms, or (P)atient? " R GMREDB:DTIME I "^"[GMREDB!('$T)!(GMREDB="") S GMROUT=1 Q
 S:GMREDB?1L GMREDB=$C($A(GMREDB)-32) S:"Uu"[GMREDB GMREDB="W" I "Ww"[GMREDB!("Ss"[GMREDB)!("Pp"[GMREDB) G WP1
 I GMREDB?1"?".E G WARDPAT
 W !,$C(7),?5,"INVALID ENTRY ??" G WARDPAT
WP1 ;
 I "Ww"[GMREDB!("Ss"[GMREDB) D WARDSEL G:GMROUT QUIT G WARDPAT:GNORM,QUIT
 D PATDAT G QUIT
WARDSEL ; SELECT UNIT TO BE SEARCHED
 I '$D(^NURSF(211.4)) S GMROUT=1 Q
 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)"
 D ^DIC K DIC I X="^"!(+Y'>0) S GMROUT=1 Q
 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:"")
 S GMRWARD(1)=$S(GMRWARD(1)?1"NUR ".E:$P(GMRWARD(1),"NUR ",2),1:GMRWARD(1))
 ; CHECK TO SEE IF ANY PATIENTS REGISTERED ON UNIT
 I DFN="" W !,$C(7),"**** NO PATIENTS REGISTERED ON WARD ",GMRWARD(1)," ****" S GMROUT=1 Q
 Q:"Ww"[GMREDB
 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
 K GNMRC S GNURSY="" F GNURSX=1:1 S GNURSY=$O(GNRM(GNURSY)) Q:GNURSY=""  S GNMRC(GNURSX)=GNURSY
 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
 Q
RMST ;
 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)=""
 Q
PATDAT ; SINGLE PATIENT SELECTION
 D PATDAT^GMRYUT0
 Q
EN3 ; SELECT ROOMS ON A GIVEN UNIT
 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
 .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)))
 .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)))
 .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)
 W !!,"Select the NUMBER(S) of the rooms: " R GNURRMST:DTIME S:'$T GNURRMST="^" I "^"[GNURRMST!(GNURRMST="") S GMROUT=1 Q
 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
 I '(GNURRMST?.N!(GNURRMST?.NP&(GNURRMST["-"!(GNURRMST[",")))) W $C(7),"  ??" G EN3
 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))=""
 I GMROUT S GMROUT=0 G EN3
 Q
QUIT ;
 K GNDA,GND1,GNWLOC,GNURSY,GNURSX,GNURRMST,GNURI,GNURLEN,GNORM,GNMRC,GNURX,GRMSEL,X,Y
 Q
INACT42(GMWLOC) ; THIS PROCEDURE WILL CALL SUPPORTED ENTRY POINT WIN^DGPMDDCF
 ; TO DETERMINE IF UNIT LOCATION (GMWLOC) IS INACTIVE.
 N X,D0,DGPMOS
 S D0=GMWLOC D WIN^DGPMDDCF
 Q X