PSGSEL ;BIR/CML3 - SELECT ORDERS BY WARD, WARD GROUP, PATIENT, OR PRIORITY ;05/15/98 9:26 AM
;;5.0;INPATIENT MEDICATIONS;**3,111,145,243,283**;DEC 16, 1997;Build 4
SELECT ; give user choice to select search method
S:'$D(PSGSSH) PSGSSH="GENERIC"
;
;*283 - Change prompts for NOCL tag
N PSGWGSTR,PSGCLSTR,PSGCHKSTR S PSGWGSTR=$S($G(PSGNOCL):"WARD GROUP",1:"GROUP"),PSGCLSTR=$S('$G(PSGNOCL):"CLINIC (C), ",1:""),PSGCHKSTR=$S($G(PSGNOCL):",G,P,W,",1:",C,G,P,W,PR,")
F W !!,"Select by ",PSGWGSTR," (G), WARD (W), ",PSGCLSTR_$S($G(PSGPRIFL):"PATIENT (P) or PRIORITY (PR)",1:"or PATIENT (P)")_": " R PSGSS:DTIME W:'$T $C(7) S:'$T PSGSS="^" Q:"^"[PSGSS D CHK I PSGCHKSTR[(","_PSGSS_",") Q
N PSGPRMT
S PSGPRMT=$P(XQY0,U,1)
;DAM 5-01-07 Adding new prompt. If user selects to print by WARD, he is prompted to "Include Clinic Orders?" If user selects to print by CLINIC, he is prompted to "Include Ward Orders?"
S PSGINCL=""
I PSGSS["W" D
. I (PSGPRMT'["MAR") Q
. N DIR,DUOUT,DIRUT,DTOUT,X,Y
. S DIR(0)="Y"
. W !
. S DIR("A")="Include Clinic Orders"
. D ^DIR
. I Y=1 S PSGINCL=1
. I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
;
S PSGINWD=""
I PSGSS["C" D
. I (PSGPRMT'["MAR") Q
. N DIR,DUOUT,DIRUT,DTOUT,X,Y
. S DIR(0)="Y"
. W !
. S DIR("A")="Include Ward Orders"
. D ^DIR
. I Y=1 S PSGINWD=1
. I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
;End DAM 5-01-07
;
K PSGSSA Q:PSGSS'="G"
I $G(PSGNOCL)=1 S PSGSS2="W"
E F R !!,"Select by WARD GROUP (W) or CLINIC GROUP (C): ",PSGSS2:DTIME W:'$T $C(7) S:'$T PSGSS2="^" Q:"^"[PSGSS2 D CHK2 I "CW"[PSGSS2 Q
G SELECT:PSGSS2="" S PSGSS=$S(PSGSS2="C":"L",1:"G")
;
;DAM 5-01-07 Adding new prompt. If user selects to print by WARD GROUP, he is prompted to "Include Clinic Orders?" If user selects to print by CLINIC GROUP, he is prompted to "Include Ward Orders?"
S PSGINCLG=""
I PSGSS2["W" D
. I (PSGPRMT'["MAR") Q
. N DIR,DUOUT,DIRUT,DTOUT,X,Y
. S DIR(0)="Y"
. W !
. S DIR("A")="Include Clinic Orders"
. D ^DIR
. I Y=1 S PSGINCLG=1
. I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
;
S PSGINWDG=""
I PSGSS2["C" D
. I (PSGPRMT'["MAR") Q
. N DIR,DUOUT,DIRUT,DTOUT,X,Y
. S DIR(0)="Y"
. W !
. S DIR("A")="Include Ward Orders"
. D ^DIR
. I Y=1 S PSGINWDG=1
. I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
;End DAM 5-01-07
;
K PSGSSA Q
;
CHK ;
S PSGSSA="" F Q=1:1:$L(PSGSS) S PSGSSA=PSGSSA_$S($E(PSGSS,Q)'?1L:$E(PSGSS,Q),1:$C($A(PSGSS,Q)-32))
F X=$S($G(PSGNOCL):"GROUP",1:"CLINIC"),"GROUP","WARD","PATIENT",$S($G(PSGPRIFL):"PRIORITY",1:"PATIENT") I $P(X,PSGSSA)="" W $P(X,PSGSSA,2,99) S PSGSS=$S($E(PSGSSA,1,2)="PR":"PR",1:$E(PSGSSA)) Q
Q:$T I PSGSS'?1."?" W $C(7)," ??" S PSGSS="Z" Q
W ! D @PSGSSH W !!?2,"To leave this option, press the RETURN key or enter '^'." Q
;
CHK2 ;
S PSGSSA="" F Q=1:1:$L(PSGSS2) S PSGSSA=PSGSSA_$S($E(PSGSS2,Q)'?1L:$E(PSGSS2,Q),1:$C($A(PSGSS2,Q)-32))
F X="WARD","CLINIC" I $P(X,PSGSSA)="" W $P(X,PSGSSA,2,99) S PSGSS2=$E(PSGSSA) Q
Q:$T I PSGSS2'?1."?" W $C(7)," ??" S PSGSS2="Z" Q
W ! D @PSGSSH W !!?2,"To leave this option, press the RETURN key or enter '^'." Q
;
HELP ; the following are the help text messages for the various options
;
GENERIC W !!,?2,"To run this option for an entire WARD GROUP, enter 'G'. To run this option for a single WARD, enter 'W'. To run this option for a single PATIENT, enter 'P'." Q
;
VBW W !!?2,"To verify all of the orders in an entire WARD GROUP, enter 'G'. To verify"
W !,"all of the orders in an entire CLINIC GROUP, enter 'CG'. To verify all of the"
W !,"orders in a single WARD, enter 'W'. To verify all of the orders in a single"
W !,"CLINIC, enter 'C'. To verify all of the orders for a single PATIENT, enter"
W !,"'P'."
I $G(PSGPRIFL) W " To verify all of the orders for a single PRIORITY, enter 'PR'."
Q
;
EXP W !?2,"To print STOP ORDER NOTICES for an entire WARD GROUP, enter 'G'. To print notices for a single WARD, enter 'W'. To print notices for a single PATIENT, enter 'P'." Q
;
MAR W !?2,"To run a Medication Administration Record (MAR or CMR) for an entire WARD",!,"GROUP, enter 'G'. To run an MAR for a single WARD, enter 'W'. To run an MAR for a single PATIENT, enter 'P'." Q
;
LBL W !?2,"To print labels for all of the orders in an entire WARD GROUP, enter 'G'. To print labels for all of the orders in a WARD, enter 'W'. To print the",!,"labels for a single PATIENT, enter 'P'." Q
;
TCR W !?2,"To run a TOTAL COST REPORT for an entire WARD GROUP, enter 'G'. To run the report for a single WARD, enter 'W'. To run the report for a single PATIENT,",!,"or a set of PATIENTS, enter 'P'." Q
;
PPR W !?2,"To print PATIENT PROFILES for an entire WARD GROUP, enter 'G'. To print profiles for a single WARD, enter 'W'. To print a profile for a single",!,"PATIENT, enter 'P'." Q
;
AP W !?2,"To print ACTION PROFILES for an entire WARD GROUP, enter 'G'. To print",!,"ACTION PROFILES for a single WARD, enter 'W'. To print an ACTION PROFILE",!,"for a single patient, enter 'P'. PLEASE NOTE that only patients"
W " with active",!,"orders are selectable, and that only patients with active orders will print for",!,"a ward or ward group." Q
ORVC W !?2,"To complete orders for an entire WARD GROUP, enter 'G'. To complete orders for an entire CLINIC GROUP, enter 'CG'"
W "To complete orders for a single WARD, enter 'W'. To complete orders for a single PATIENT, enter",!,"a 'P'." Q
;
PRI ; Priompt for Priority along with Group, Ward, Clinic and Patient
S PSGPRIFL=1 D SELECT K PSGPRIFL
Q
;
NOCL ; *283 - Prompt to only allow Ward Group, Ward, and Patient
N PSGNOCL S PSGNOCL=1 D SELECT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGSEL 5698 printed Sep 23, 2025@19:39:16 Page 2
PSGSEL ;BIR/CML3 - SELECT ORDERS BY WARD, WARD GROUP, PATIENT, OR PRIORITY ;05/15/98 9:26 AM
+1 ;;5.0;INPATIENT MEDICATIONS;**3,111,145,243,283**;DEC 16, 1997;Build 4
SELECT ; give user choice to select search method
+1 if '$DATA(PSGSSH)
SET PSGSSH="GENERIC"
+2 ;
+3 ;*283 - Change prompts for NOCL tag
+4 NEW PSGWGSTR,PSGCLSTR,PSGCHKSTR
SET PSGWGSTR=$SELECT($GET(PSGNOCL):"WARD GROUP",1:"GROUP")
SET PSGCLSTR=$SELECT('$GET(PSGNOCL):"CLINIC (C), ",1:"")
SET PSGCHKSTR=$SELECT($GET(PSGNOCL):",G,P,W,",1:",C,G,P,W,PR,")
+5 FOR
WRITE !!,"Select by ",PSGWGSTR," (G), WARD (W), ",PSGCLSTR_$SELECT($GET(PSGPRIFL):"PATIENT (P) or PRIORITY (PR)",1:"or PATIENT (P)")_": "
READ PSGSS:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET PSGSS="^"
if "^"[PSGSS
QUIT
DO CHK
IF PSGCHKSTR[(","_PSGSS_",")
QUIT
+6 NEW PSGPRMT
+7 SET PSGPRMT=$PIECE(XQY0,U,1)
+8 ;DAM 5-01-07 Adding new prompt. If user selects to print by WARD, he is prompted to "Include Clinic Orders?" If user selects to print by CLINIC, he is prompted to "Include Ward Orders?"
+9 SET PSGINCL=""
+10 IF PSGSS["W"
Begin DoDot:1
+11 IF (PSGPRMT'["MAR")
QUIT
+12 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+13 SET DIR(0)="Y"
+14 WRITE !
+15 SET DIR("A")="Include Clinic Orders"
+16 DO ^DIR
+17 IF Y=1
SET PSGINCL=1
+18 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+19 ;
+20 SET PSGINWD=""
+21 IF PSGSS["C"
Begin DoDot:1
+22 IF (PSGPRMT'["MAR")
QUIT
+23 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+24 SET DIR(0)="Y"
+25 WRITE !
+26 SET DIR("A")="Include Ward Orders"
+27 DO ^DIR
+28 IF Y=1
SET PSGINWD=1
+29 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+30 ;End DAM 5-01-07
+31 ;
+32 KILL PSGSSA
if PSGSS'="G"
QUIT
+33 IF $GET(PSGNOCL)=1
SET PSGSS2="W"
+34 IF '$TEST
FOR
READ !!,"Select by WARD GROUP (W) or CLINIC GROUP (C): ",PSGSS2:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET PSGSS2="^"
if "^"[PSGSS2
QUIT
DO CHK2
IF "CW"[PSGSS2
QUIT
+35 if PSGSS2=""
GOTO SELECT
SET PSGSS=$SELECT(PSGSS2="C":"L",1:"G")
+36 ;
+37 ;DAM 5-01-07 Adding new prompt. If user selects to print by WARD GROUP, he is prompted to "Include Clinic Orders?" If user selects to print by CLINIC GROUP, he is prompted to "Include Ward Orders?"
+38 SET PSGINCLG=""
+39 IF PSGSS2["W"
Begin DoDot:1
+40 IF (PSGPRMT'["MAR")
QUIT
+41 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+42 SET DIR(0)="Y"
+43 WRITE !
+44 SET DIR("A")="Include Clinic Orders"
+45 DO ^DIR
+46 IF Y=1
SET PSGINCLG=1
+47 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+48 ;
+49 SET PSGINWDG=""
+50 IF PSGSS2["C"
Begin DoDot:1
+51 IF (PSGPRMT'["MAR")
QUIT
+52 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+53 SET DIR(0)="Y"
+54 WRITE !
+55 SET DIR("A")="Include Ward Orders"
+56 DO ^DIR
+57 IF Y=1
SET PSGINWDG=1
+58 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+59 ;End DAM 5-01-07
+60 ;
+61 KILL PSGSSA
QUIT
+62 ;
CHK ;
+1 SET PSGSSA=""
FOR Q=1:1:$LENGTH(PSGSS)
SET PSGSSA=PSGSSA_$SELECT($EXTRACT(PSGSS,Q)'?1L:$EXTRACT(PSGSS,Q),1:$CHAR($ASCII(PSGSS,Q)-32))
+2 FOR X=$SELECT($GET(PSGNOCL):"GROUP",1:"CLINIC"),"GROUP","WARD","PATIENT",$SELECT($GET(PSGPRIFL):"PRIORITY",1:"PATIENT")
IF $PIECE(X,PSGSSA)=""
WRITE $PIECE(X,PSGSSA,2,99)
SET PSGSS=$SELECT($EXTRACT(PSGSSA,1,2)="PR":"PR",1:$EXTRACT(PSGSSA))
QUIT
+3 if $TEST
QUIT
IF PSGSS'?1."?"
WRITE $CHAR(7)," ??"
SET PSGSS="Z"
QUIT
+4 WRITE !
DO @PSGSSH
WRITE !!?2,"To leave this option, press the RETURN key or enter '^'."
QUIT
+5 ;
CHK2 ;
+1 SET PSGSSA=""
FOR Q=1:1:$LENGTH(PSGSS2)
SET PSGSSA=PSGSSA_$SELECT($EXTRACT(PSGSS2,Q)'?1L:$EXTRACT(PSGSS2,Q),1:$CHAR($ASCII(PSGSS2,Q)-32))
+2 FOR X="WARD","CLINIC"
IF $PIECE(X,PSGSSA)=""
WRITE $PIECE(X,PSGSSA,2,99)
SET PSGSS2=$EXTRACT(PSGSSA)
QUIT
+3 if $TEST
QUIT
IF PSGSS2'?1."?"
WRITE $CHAR(7)," ??"
SET PSGSS2="Z"
QUIT
+4 WRITE !
DO @PSGSSH
WRITE !!?2,"To leave this option, press the RETURN key or enter '^'."
QUIT
+5 ;
HELP ; the following are the help text messages for the various options
+1 ;
GENERIC WRITE !!,?2,"To run this option for an entire WARD GROUP, enter 'G'. To run this option for a single WARD, enter 'W'. To run this option for a single PATIENT, enter 'P'."
QUIT
+1 ;
VBW WRITE !!?2,"To verify all of the orders in an entire WARD GROUP, enter 'G'. To verify"
+1 WRITE !,"all of the orders in an entire CLINIC GROUP, enter 'CG'. To verify all of the"
+2 WRITE !,"orders in a single WARD, enter 'W'. To verify all of the orders in a single"
+3 WRITE !,"CLINIC, enter 'C'. To verify all of the orders for a single PATIENT, enter"
+4 WRITE !,"'P'."
+5 IF $GET(PSGPRIFL)
WRITE " To verify all of the orders for a single PRIORITY, enter 'PR'."
+6 QUIT
+7 ;
EXP WRITE !?2,"To print STOP ORDER NOTICES for an entire WARD GROUP, enter 'G'. To print notices for a single WARD, enter 'W'. To print notices for a single PATIENT, enter 'P'."
QUIT
+1 ;
MAR WRITE !?2,"To run a Medication Administration Record (MAR or CMR) for an entire WARD",!,"GROUP, enter 'G'. To run an MAR for a single WARD, enter 'W'. To run an MAR for a single PATIENT, enter 'P'."
QUIT
+1 ;
LBL WRITE !?2,"To print labels for all of the orders in an entire WARD GROUP, enter 'G'. To print labels for all of the orders in a WARD, enter 'W'. To print the",!,"labels for a single PATIENT, enter 'P'."
QUIT
+1 ;
TCR WRITE !?2,"To run a TOTAL COST REPORT for an entire WARD GROUP, enter 'G'. To run the report for a single WARD, enter 'W'. To run the report for a single PATIENT,",!,"or a set of PATIENTS, enter 'P'."
QUIT
+1 ;
PPR WRITE !?2,"To print PATIENT PROFILES for an entire WARD GROUP, enter 'G'. To print profiles for a single WARD, enter 'W'. To print a profile for a single",!,"PATIENT, enter 'P'."
QUIT
+1 ;
AP WRITE !?2,"To print ACTION PROFILES for an entire WARD GROUP, enter 'G'. To print",!,"ACTION PROFILES for a single WARD, enter 'W'. To print an ACTION PROFILE",!,"for a single patient, enter 'P'. PLEASE NOTE that only patients"
+1 WRITE " with active",!,"orders are selectable, and that only patients with active orders will print for",!,"a ward or ward group."
QUIT
ORVC WRITE !?2,"To complete orders for an entire WARD GROUP, enter 'G'. To complete orders for an entire CLINIC GROUP, enter 'CG'"
+1 WRITE "To complete orders for a single WARD, enter 'W'. To complete orders for a single PATIENT, enter",!,"a 'P'."
QUIT
+2 ;
PRI ; Priompt for Priority along with Group, Ward, Clinic and Patient
+1 SET PSGPRIFL=1
DO SELECT
KILL PSGPRIFL
+2 QUIT
+3 ;
NOCL ; *283 - Prompt to only allow Ward Group, Ward, and Patient
+1 NEW PSGNOCL
SET PSGNOCL=1
DO SELECT
+2 QUIT
