GMRYRP5 ;HIRMFO/YH,RM-PATIENT SEARCH BY MAS WARD ;11/7/95
;;4.0;Intake/Output;;Apr 25, 1997
MASPT D WARDPAT G:GMROUT Q G:"Pp"[GMREDB Q D:"Ss"[GMREDB ROOM G:GMROUT Q D WARD
Q K GMRMSL,GMRRMST,GMRROOM,VAIN,GRM,GBED,GMRRMBD,GMRQUAL Q
WARDPAT ; SELECT EDIT BY 1. UNIT, 2. SELECTED ROOMS ON UNIT, 3. PATIENT
S GMRVWLOC="" W !,"by (A)ll patients on a unit, (S)elected Rooms on unit, or (P)atient? " R GMREDB:DTIME S:'$T GMREDB=U I U[GMREDB S GMROUT=1 Q
S GMREDB=$S("Aa"[GMREDB:"W","Ss"[GMREDB:"S","Pp"[GMREDB:"P",1:"") I GMREDB="" W !!,"Enter A for all patients on a unit,",!," S for the selected rooms on unit, or",!," P for a patient.",!! G WARDPAT
I "Ww"[GMREDB!("Ss"[GMREDB)!("P1p"[GMREDB) G WP1
W !,$C(7),?5,"INVALID ENTRY ??" G WARDPAT
WP1 ;
I "Ww"[GMREDB!("Ss"[GMREDB) D WARDSEL Q:GMROUT Q:"Ss"'[GMREDB!("Ss"[GMREDB&($D(^DG(405.4,"W",GMRWARD)))) S XQH="GMRV NO ROOM" D EN^XQH K XQH G WARDPAT
D PATDAT
Q
WARDSEL ; SELECT SEARCH WARD
S DIC="^DIC(42,",DIC(0)="AEQMZ",DIC("S")="I '$$INACT42^GMRYUT4(+Y)"
D ^DIC K DIC I X=U!(+Y'>0) S GMROUT=1 Q
S GMRWARD=+Y,GMRWARD(1)=$P(Y(0),U),DFN=$O(^DPT("CN",GMRWARD(1),0))
I DFN="" W !,*7,"**** NO PATIENTS REGISTERED ON UNIT ",$P(^DIC(42,GMRWARD,0),U)," ****" S GMROUT=1 Q
S GMRVHLOC=$S($D(^DIC(42,GMRWARD,44)):$P(^(44),U),1:"")
Q
PATDAT ;
S DIC(0)="AEQMZ",DIC="^DPT(" D ^DIC K DIC S DFN=+Y
I DFN'>0 S GMROUT=1 Q
D 1^VADPT S GMRWARD(1)=$P(VAIN(4),U,2),GMRWARD=$P(VAIN(4),U),GMRRMBD=$S(VAIN(5)'="":VAIN(5),1:""),GMRNAM=$S(VADM(1)'="":VADM(1),1:"BLANK"),GRM=$S($P(GMRRMBD,"-")'="":$P(GMRRMBD,"-"),1:"BLANK")
S GBED=$S($P(GMRRMBD,"-",2)'="":$P(GMRRMBD,"-",2),1:"BLANK"),^TMP("GMRPT",$J,GRM,GBED,DFN)=GMRNAM D KVAR^VADPT K VA
;I ('$D(GMRWARD)!(GMRWARD'>0)),"P1p"[GMREDB S:GMRWARD=0 GMROUT=1 Q:GMROUT
Q
HOSP S DIC("A")="Select Hospital Location: ",DIC("B")=$S('$D(^DIC(42,+GMRWARD,44)):"",$D(^SC(+$P(^DIC(42,+GMRWARD,44),U),0)):$P(^(0),U),1:""),DIC=44,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,3)'=""Z""" D ^DIC K DIC I +Y'>0 S GMROUT=1 Q
S GMRVHLOC=+Y
Q
WARD ; SORT PATIENTS ON WARD
K ^TMP("GMRPT",$J)
WSA1 ; STORE SELECTED WARD/ROOM PATIENTS IN ^TMP("GMRPT",$J)
D DEM^VADPT,INP^VADPT S GMRRMBD=$S(VAIN(5)'="":VAIN(5),1:""),GMRNAM=$S(VADM(1)'="":VADM(1),1:"BLANK"),GRM=$S($P(GMRRMBD,"-")'="":$P(GMRRMBD,"-"),1:"BLANK"),GBED=$S($P(GMRRMBD,"-",2)'="":$P(GMRRMBD,"-",2),1:"BLANK") D KVAR^VADPT K VA
S:$S("W"[GMREDB:1,$D(GMRROOM($P(GRM,"-"))):1,1:0) ^TMP("GMRPT",$J,GRM,GBED,DFN)=GMRNAM
S DFN=$O(^DPT("CN",GMRWARD(1),DFN))
Q:DFN="" G WSA1
ROOM ; SELECT ROOMS ON A GIVEN WARD
K GMRMSL
I $D(^DG(405.4,0)) S X=0 F Y=1:0 S X=$O(^DG(405.4,"W",GMRWARD,X)) Q:X'>0 I $D(^DG(405.4,X,0)),$P($P(^(0),"^"),"-")'="" S:'$D(GMRMSL("B",$P($P(^(0),"^"),"-"))) GMRMSL(Y)=$P($P(^(0),"^"),"-"),GMRMSL("B",$P($P(^(0),"^"),"-"))="",Y=Y+1
S GMRMSL=Y-1
S3 K I S I(1)=1,I(2)=21,I(3)=41,I(4)=61,I(5)=81 W !!,"Unit "_GMRWARD(1)_" has the following Rooms:",! F Y=0:0 S Y=$O(GMRMSL(Y)) Q:Y'>0!(Y'<21) D ROOMSEL^GMRYUT12
W !!,"Select the NUMBER(S) of the Rooms: "
R GMRRMST:DTIME I "^"[GMRRMST!'$T!(GMRRMST="") S GMROUT=1 Q
I GMRRMST?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 S3
I '(GMRRMST?.N!(GMRRMST?.NP&(GMRRMST["-"!(GMRRMST[",")))) W $C(7)," ??" G S3
F GMRI=1:1 S GMRLEN=$P(GMRRMST,",",GMRI) Q:GMRLEN="" S GMRLEN(1)=$P(GMRLEN,"-",2)_"+"_GMRLEN F GMRX=+GMRLEN:1:+GMRLEN(1) D RMCHK I GMROUT S GMROUT=0 G S3
Q
RMCHK ;
I '$D(GMRMSL(GMRX)) W !?5,$C(7),"Please select a number between 1 and ",GMRMSL S GMROUT=1 Q
S:GMRX=+GMRX GMRROOM(GMRMSL(GMRX))=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYRP5 3703 printed Oct 16, 2024@17:56:23 Page 2
GMRYRP5 ;HIRMFO/YH,RM-PATIENT SEARCH BY MAS WARD ;11/7/95
+1 ;;4.0;Intake/Output;;Apr 25, 1997
MASPT DO WARDPAT
if GMROUT
GOTO Q
if "Pp"[GMREDB
GOTO Q
if "Ss"[GMREDB
DO ROOM
if GMROUT
GOTO Q
DO WARD
Q KILL GMRMSL,GMRRMST,GMRROOM,VAIN,GRM,GBED,GMRRMBD,GMRQUAL
QUIT
WARDPAT ; SELECT EDIT BY 1. UNIT, 2. SELECTED ROOMS ON UNIT, 3. PATIENT
+1 SET GMRVWLOC=""
WRITE !,"by (A)ll patients on a unit, (S)elected Rooms on unit, or (P)atient? "
READ GMREDB:DTIME
if '$TEST
SET GMREDB=U
IF U[GMREDB
SET GMROUT=1
QUIT
+2 SET GMREDB=$SELECT("Aa"[GMREDB:"W","Ss"[GMREDB:"S","Pp"[GMREDB:"P",1:"")
IF GMREDB=""
WRITE !!,"Enter A for all patients on a unit,",!," S for the selected rooms on unit, or",!," P for a patient.",!!
GOTO WARDPAT
+3 IF "Ww"[GMREDB!("Ss"[GMREDB)!("P1p"[GMREDB)
GOTO WP1
+4 WRITE !,$CHAR(7),?5,"INVALID ENTRY ??"
GOTO WARDPAT
WP1 ;
+1 IF "Ww"[GMREDB!("Ss"[GMREDB)
DO WARDSEL
if GMROUT
QUIT
if "Ss"'[GMREDB!("Ss"[GMREDB&($DATA(^DG(405.4,"W",GMRWARD))))
QUIT
SET XQH="GMRV NO ROOM"
DO EN^XQH
KILL XQH
GOTO WARDPAT
+2 DO PATDAT
+3 QUIT
WARDSEL ; SELECT SEARCH WARD
+1 SET DIC="^DIC(42,"
SET DIC(0)="AEQMZ"
SET DIC("S")="I '$$INACT42^GMRYUT4(+Y)"
+2 DO ^DIC
KILL DIC
IF X=U!(+Y'>0)
SET GMROUT=1
QUIT
+3 SET GMRWARD=+Y
SET GMRWARD(1)=$PIECE(Y(0),U)
SET DFN=$ORDER(^DPT("CN",GMRWARD(1),0))
+4 IF DFN=""
WRITE !,*7,"**** NO PATIENTS REGISTERED ON UNIT ",$PIECE(^DIC(42,GMRWARD,0),U)," ****"
SET GMROUT=1
QUIT
+5 SET GMRVHLOC=$SELECT($DATA(^DIC(42,GMRWARD,44)):$PIECE(^(44),U),1:"")
+6 QUIT
PATDAT ;
+1 SET DIC(0)="AEQMZ"
SET DIC="^DPT("
DO ^DIC
KILL DIC
SET DFN=+Y
+2 IF DFN'>0
SET GMROUT=1
QUIT
+3 DO 1^VADPT
SET GMRWARD(1)=$PIECE(VAIN(4),U,2)
SET GMRWARD=$PIECE(VAIN(4),U)
SET GMRRMBD=$SELECT(VAIN(5)'="":VAIN(5),1:"")
SET GMRNAM=$SELECT(VADM(1)'="":VADM(1),1:"BLANK")
SET GRM=$SELECT($PIECE(GMRRMBD,"-")'="":$PIECE(GMRRMBD,"-"),1:"BLANK")
+4 SET GBED=$SELECT($PIECE(GMRRMBD,"-",2)'="":$PIECE(GMRRMBD,"-",2),1:"BLANK")
SET ^TMP("GMRPT",$JOB,GRM,GBED,DFN)=GMRNAM
DO KVAR^VADPT
KILL VA
+5 ;I ('$D(GMRWARD)!(GMRWARD'>0)),"P1p"[GMREDB S:GMRWARD=0 GMROUT=1 Q:GMROUT
+6 QUIT
HOSP SET DIC("A")="Select Hospital Location: "
SET DIC("B")=$SELECT('$DATA(^DIC(42,+GMRWARD,44)):"",$DATA(^SC(+$PIECE(^DIC(42,+GMRWARD,44),U),0)):$PIECE(^(0),U),1:"")
SET DIC=44
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,3)'=""Z"""
DO ^DIC
KILL DIC
IF +Y'>0
SET GMROUT=1
QUIT
+1 SET GMRVHLOC=+Y
+2 QUIT
WARD ; SORT PATIENTS ON WARD
+1 KILL ^TMP("GMRPT",$JOB)
WSA1 ; STORE SELECTED WARD/ROOM PATIENTS IN ^TMP("GMRPT",$J)
+1 DO DEM^VADPT
DO INP^VADPT
SET GMRRMBD=$SELECT(VAIN(5)'="":VAIN(5),1:"")
SET GMRNAM=$SELECT(VADM(1)'="":VADM(1),1:"BLANK")
SET GRM=$SELECT($PIECE(GMRRMBD,"-")'="":$PIECE(GMRRMBD,"-"),1:"BLANK")
SET GBED=$SELECT($PIECE(GMRRMBD,"-",2)'="":$PIECE(GMRRMBD,"-",2),1:"BLANK")
DO KVAR^VADPT
KILL VA
+2 if $SELECT("W"[GMREDB
SET ^TMP("GMRPT",$JOB,GRM,GBED,DFN)=GMRNAM
+3 SET DFN=$ORDER(^DPT("CN",GMRWARD(1),DFN))
+4 if DFN=""
QUIT
GOTO WSA1
ROOM ; SELECT ROOMS ON A GIVEN WARD
+1 KILL GMRMSL
+2 IF $DATA(^DG(405.4,0))
SET X=0
FOR Y=1:0
SET X=$ORDER(^DG(405.4,"W",GMRWARD,X))
if X'>0
QUIT
IF $DATA(^DG(405.4,X,0))
IF $PIECE($PIECE(^(0),"^"),"-")'=""
if '$DATA(GMRMSL("B",$PIECE($PIECE(^(0),"^"),"-")))
SET GMRMSL(Y)=$PIECE($PIECE(^(0),"^"),"-")
SET GMRMSL("B",$PIECE($PIECE(^(0),"^"),"-"))=""
SET Y=Y+1
+3 SET GMRMSL=Y-1
S3 KILL I
SET I(1)=1
SET I(2)=21
SET I(3)=41
SET I(4)=61
SET I(5)=81
WRITE !!,"Unit "_GMRWARD(1)_" has the following Rooms:",!
FOR Y=0:0
SET Y=$ORDER(GMRMSL(Y))
if Y'>0!(Y'<21)
QUIT
DO ROOMSEL^GMRYUT12
+1 WRITE !!,"Select the NUMBER(S) of the Rooms: "
+2 READ GMRRMST:DTIME
IF "^"[GMRRMST!'$TEST!(GMRRMST="")
SET GMROUT=1
QUIT
+3 IF GMRRMST?1"?".E
WRITE !,?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)."
GOTO S3
+4 IF '(GMRRMST?.N!(GMRRMST?.NP&(GMRRMST["-"!(GMRRMST[","))))
WRITE $CHAR(7)," ??"
GOTO S3
+5 FOR GMRI=1:1
SET GMRLEN=$PIECE(GMRRMST,",",GMRI)
if GMRLEN=""
QUIT
SET GMRLEN(1)=$PIECE(GMRLEN,"-",2)_"+"_GMRLEN
FOR GMRX=+GMRLEN:1:+GMRLEN(1)
DO RMCHK
IF GMROUT
SET GMROUT=0
GOTO S3
+6 QUIT
RMCHK ;
+1 IF '$DATA(GMRMSL(GMRX))
WRITE !?5,$CHAR(7),"Please select a number between 1 and ",GMRMSL
SET GMROUT=1
QUIT
+2 if GMRX=+GMRX
SET GMRROOM(GMRMSL(GMRX))=""
+3 QUIT
