GMRYRP5.m

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 ---GMRYRP5   3703     printed  Apr 23, 2025@18:10:04                                                                                                                                                                                                     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