PSGSEL ;BIR/CML3-SELECT ORDERS BY WARD, WARD GROUP, OR PATIENT ; 15 May 98 / 9:26 AM
;;5.0; INPATIENT MEDICATIONS ;**3,111,145**;16 DEC 97;Build 17
SELECT ; give user choice to select by
S:'$D(PSGSSH) PSGSSH="GENERIC"
F R !!,"Select by GROUP (G), WARD (W), CLINIC (C), or PATIENT (P): ",PSGSS:DTIME W:'$T $C(7) S:'$T PSGSS="^" Q:"^"[PSGSS D CHK I "CGPW"[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"
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 ;
;I PSGSS=" ",$D(^DISV(DUZ,"PSGSEL")) S PSGSS=^("PSGSEL") W $S(PSGSS="P":"PATIENT",PSGSS="W":"WARD",PSGSS="G":"GROUP",1:"") Q:PSGSS]""&("GPW"[PSGSS)
I PSGSS=" " W $S(PSGSS="P":"PATIENT",PSGSS="W":"WARD",PSGSS="G":"GROUP",PSGSS="C":"CLINIC",1:"") Q:PSGSS]""&("GPWC"[PSGSS)
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="CLINIC","GROUP","WARD","PATIENT" I $P(X,PSGSSA)="" W $P(X,PSGSSA,2,99) S PSGSS=$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 an '^'." 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 an '^'." 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 a 'G'. To run this option for a single WARD, enter a 'W'. To run this option for a single PATIENT, enter a 'P'." Q
;
VBW W !!?2,"To verify all of the orders in an entire WARD GROUP, enter a 'G'. To verify all of the orders in an entire CLNIC GROUP, enter 'CG'."
W " To verify all of the orders in a single WARD, enter a 'W'. To verify all of the orders in a single CLINIC, enter a 'C'."
W "To verify all of the orders for a single PATIENT, enter a 'P'." Q
;
EXP W !?2,"To print STOP ORDER NOTICES for an entire WARD GROUP, enter a 'G'. To print notices for a single WARD, enter a 'W'. To print notices for a single PATIENT, enter a 'P'." Q
;
MAR W !?2,"To run a Medication Administration Record (MAR or CMR) for an entire WARD",!,"GROUP, enter a 'G'. To run an MAR for a single WARD, enter a 'W'. To run an MAR for a single PATIENT, enter a 'P'." Q
;
LBL W !?2,"To print labels for all of the orders in an entire WARD GROUP, enter a 'G'. To print labels for all of the orders in a WARD, enter a 'W'. To print the",!,"labels for a single PATIENT, enter a 'P'." Q
;
TCR W !?2,"To run a TOTAL COST REPORT for an entire WARD GROUP, enter a 'G'. To run the report for a single WARD, enter a 'W'. To run the report for a single PATIENT,",!,"or a set of PATIENTS, enter a 'P'." Q
;
PPR W !?2,"To print PATIENT PROFILES for an entire WARD GROUP, enter a 'G'. To print profiles for a single WARD, enter a 'W'. To print a profile for a single",!,"PATIENT, enter a 'P'." Q
;
AP W !?2,"To print ACTION PROFILES for an entire WARD GROUP, enter a 'G'. To print",!,"ACTION PROFILES for a single WARD, enter a 'W'. To print an ACTION PROFILE",!,"for a single patient, enter a '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 a 'G'. To complete orders for an entire CLINIC GROUP, enter 'CG'"
W "To complete orders for a single WARD, enter a 'W'. To complete orders for a single PATIENT, enter",!,"a 'P'." Q
PSGSEL ;BIR/CML3-SELECT ORDERS BY WARD, WARD GROUP, OR PATIENT ; 15 May 98 / 9:26 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**3,111,145**;16 DEC 97;Build 17
SELECT ; give user choice to select by
+1 IF '$DATA(PSGSSH)
SET PSGSSH="GENERIC"
+2 FOR
READ !!,"Select by GROUP (G), WARD (W), CLINIC (C), or PATIENT (P): ",PSGSS:DTIME
IF '$TEST
WRITE $CHAR(7)
IF '$TEST
SET PSGSS="^"
IF "^"[PSGSS
QUIT
DO CHK
IF "CGPW"[PSGSS
QUIT
+3 ;
+4 NEW PSGPRMT
+5 SET PSGPRMT=$PIECE(XQY0,U,1)
+6 ;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?"
+7 SET PSGINCL=""
+8 IF PSGSS["W"
Begin DoDot:1
+9 IF (PSGPRMT'["MAR")
QUIT
+10 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+11 SET DIR(0)="Y"
+12 WRITE !
+13 SET DIR("A")="Include Clinic Orders"
+14 DO ^DIR
+15 IF Y=1
SET PSGINCL=1
+16 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+17 ;
+18 SET PSGINWD=""
+19 IF PSGSS["C"
Begin DoDot:1
+20 IF (PSGPRMT'["MAR")
QUIT
+21 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+22 SET DIR(0)="Y"
+23 WRITE !
+24 SET DIR("A")="Include Ward Orders"
+25 DO ^DIR
+26 IF Y=1
SET PSGINWD=1
+27 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+28 ;End DAM 5-01-07
+29 ;
+30 KILL PSGSSA
IF PSGSS'="G"
QUIT
+31 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
+32 IF PSGSS2=""
GOTO SELECT
SET PSGSS=$SELECT(PSGSS2="C":"L",1:"G")
+33 ;
+34 ;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?"
+35 SET PSGINCLG=""
+36 IF PSGSS2["W"
Begin DoDot:1
+37 IF (PSGPRMT'["MAR")
QUIT
+38 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+39 SET DIR(0)="Y"
+40 WRITE !
+41 SET DIR("A")="Include Clinic Orders"
+42 DO ^DIR
+43 IF Y=1
SET PSGINCLG=1
+44 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+45 ;
+46 SET PSGINWDG=""
+47 IF PSGSS2["C"
Begin DoDot:1
+48 IF (PSGPRMT'["MAR")
QUIT
+49 NEW DIR,DUOUT,DIRUT,DTOUT,X,Y
+50 SET DIR(0)="Y"
+51 WRITE !
+52 SET DIR("A")="Include Ward Orders"
+53 DO ^DIR
+54 IF Y=1
SET PSGINWDG=1
+55 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT))
SET Y=0
End DoDot:1
+56 ;End DAM 5-01-07
+57 ;
+58 KILL PSGSSA
QUIT
+59 ;
CHK ;
+1 ;I PSGSS=" ",$D(^DISV(DUZ,"PSGSEL")) S PSGSS=^("PSGSEL") W $S(PSGSS="P":"PATIENT",PSGSS="W":"WARD",PSGSS="G":"GROUP",1:"") Q:PSGSS]""&("GPW"[PSGSS)
+2 IF PSGSS=" "
WRITE $SELECT(PSGSS="P":"PATIENT",PSGSS="W":"WARD",PSGSS="G":"GROUP",PSGSS="C":"CLINIC",1:"")
IF PSGSS]""&("GPWC"[PSGSS)
QUIT
+3 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))
+4 FOR X="CLINIC","GROUP","WARD","PATIENT"
IF $PIECE(X,PSGSSA)=""
WRITE $PIECE(X,PSGSSA,2,99)
SET PSGSS=$EXTRACT(PSGSSA)
QUIT
+5 IF $TEST
QUIT
IF PSGSS'?1."?"
WRITE $CHAR(7)," ??"
SET PSGSS="Z"
QUIT
+6 WRITE !
DO @PSGSSH
WRITE !!?2,"To leave this option, press the RETURN key or enter an '^'."
QUIT
+7 ;
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 an '^'."
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 a 'G'. To run this option for a single WARD, enter a 'W'. To run this option for a single PATIENT, enter a 'P'."
QUIT
+1 ;
VBW WRITE !!?2,"To verify all of the orders in an entire WARD GROUP, enter a 'G'. To verify all of the orders in an entire CLNIC GROUP, enter 'CG'."
+1 WRITE " To verify all of the orders in a single WARD, enter a 'W'. To verify all of the orders in a single CLINIC, enter a 'C'."
+2 WRITE "To verify all of the orders for a single PATIENT, enter a 'P'."
QUIT
+3 ;
EXP WRITE !?2,"To print STOP ORDER NOTICES for an entire WARD GROUP, enter a 'G'. To print notices for a single WARD, enter a 'W'. To print notices for a single PATIENT, enter a 'P'."
QUIT
+1 ;
MAR WRITE !?2,"To run a Medication Administration Record (MAR or CMR) for an entire WARD",!,"GROUP, enter a 'G'. To run an MAR for a single WARD, enter a 'W'. To run an MAR for a single PATIENT, enter a 'P'."
QUIT
+1 ;
LBL WRITE !?2,"To print labels for all of the orders in an entire WARD GROUP, enter a 'G'. To print labels for all of the orders in a WARD, enter a 'W'. To print the",!,"labels for a single PATIENT, enter a 'P'."
QUIT
+1 ;
TCR WRITE !?2,"To run a TOTAL COST REPORT for an entire WARD GROUP, enter a 'G'. To run the report for a single WARD, enter a 'W'. To run the report for a single PATIENT,",!,"or a set of PATIENTS, enter a 'P'."
QUIT
+1 ;
PPR WRITE !?2,"To print PATIENT PROFILES for an entire WARD GROUP, enter a 'G'. To print profiles for a single WARD, enter a 'W'. To print a profile for a single",!,"PATIENT, enter a 'P'."
QUIT
+1 ;
AP WRITE !?2,"To print ACTION PROFILES for an entire WARD GROUP, enter a 'G'. To print",!,"ACTION PROFILES for a single WARD, enter a 'W'. To print an ACTION PROFILE",!,"for a single patient, enter a '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 a 'G'. To complete orders for an entire CLINIC GROUP, enter 'CG'"
+1 WRITE "To complete orders for a single WARD, enter a 'W'. To complete orders for a single PATIENT, enter",!,"a 'P'."
QUIT
