PSJMDIR1 ;BIR/MV-MED DUE WORKSHEET DIR CALLS CONT. ;17 JUN 96 / 1:40 PM
;;5.0; INPATIENT MEDICATIONS ;**111**;16 DEC 97
;
GWP(PSJMDWS) ;*** Ask for seletion from WARD GROUP,WARD,PATIENT
;PSJMDWS=1 when called by Med Due Work Sheet function.
K DIR S DIR(0)="SAO^G:Ward Group;W:Ward;P:Patient",DIR("A")="Select by WARD GROUP (G), WARD (W), or PATIENT (P): "
S DIR("?")="To select by PATIENT, enter a 'P'."
S DIR("?",1)="To select the entire WARD GROUP, enter a 'G'."
S DIR("?",2)="To select a single WARD, enter a 'W'."
W !! D ^DIR S PSJSTOP=$S(Y="":1,Y<0:1,$$STOP:1,1:0)
I 'PSJSTOP S PSGSS=Y D @Y
Q PSJSTOP
;
P ;*** Select by Patient
;
N PSJACNWP,PSGDICA,PAGPAT S PSJACNWP=""
F PFLG=0:1 S:PFLG PSGDICA="another" D ^PSJMP Q:PSGP<0 S PSGPAT(PPN)=PSGP I $G(PSJMDWS) S:'$G(PSJPWDO) (PSGWD,PSJPWDO)=PSJPWD S PSGWD=$S('$G(PSGWD):0,PSJPWDO=PSJPWD:PSJPWD,1:0)
S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,(Y<0)&'$D(PSGDICA):1,1:0)
Q
;
W ;*** Select by WARD
;
K DIC S DIC="^DIC(42,",DIC(0)="QEAMIZ",DIC("A")="Select a Ward: " W !! D ^DIC
S PSJSTOP=$S(Y="":1,Y<0:1,$$STOP:1,1:0)
I 'PSJSTOP S PSGWD=+Y,PSGWN=Y(0,0) D ADMTM^PSJMDIR D:'PSJSTOP&(PSJMDWS) RBADM^PSJMDIR
Q
;
G ;***Select by WARD GROUP
;
K DIC S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select a Ward Group: " W !!
D ^DIC
I Y<0,X="^OTHER" S PSJSTOP=0,PSGSS="C",(PSGWN,PSGWGNM)="OTHER" D:PSJMDWS RBADM^PSJMDIR Q
Q:$$STOP
S PSGWG=+Y,PSGWGNM=$P(Y,U,2) D:PSJMDWS RBADM^PSJMDIR
Q
;
;
STOP() ;
;
S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,1:0)
Q PSJSTOP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJMDIR1 1572 printed Dec 13, 2024@02:07:38 Page 2
PSJMDIR1 ;BIR/MV-MED DUE WORKSHEET DIR CALLS CONT. ;17 JUN 96 / 1:40 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**111**;16 DEC 97
+2 ;
GWP(PSJMDWS) ;*** Ask for seletion from WARD GROUP,WARD,PATIENT
+1 ;PSJMDWS=1 when called by Med Due Work Sheet function.
+2 KILL DIR
SET DIR(0)="SAO^G:Ward Group;W:Ward;P:Patient"
SET DIR("A")="Select by WARD GROUP (G), WARD (W), or PATIENT (P): "
+3 SET DIR("?")="To select by PATIENT, enter a 'P'."
+4 SET DIR("?",1)="To select the entire WARD GROUP, enter a 'G'."
+5 SET DIR("?",2)="To select a single WARD, enter a 'W'."
+6 WRITE !!
DO ^DIR
SET PSJSTOP=$SELECT(Y="":1,Y<0:1,$$STOP:1,1:0)
+7 IF 'PSJSTOP
SET PSGSS=Y
DO @Y
+8 QUIT PSJSTOP
+9 ;
P ;*** Select by Patient
+1 ;
+2 NEW PSJACNWP,PSGDICA,PAGPAT
SET PSJACNWP=""
+3 FOR PFLG=0:1
if PFLG
SET PSGDICA="another"
DO ^PSJMP
if PSGP<0
QUIT
SET PSGPAT(PPN)=PSGP
IF $GET(PSJMDWS)
if '$GET(PSJPWDO)
SET (PSGWD,PSJPWDO)=PSJPWD
SET PSGWD=$SELECT('$GET(PSGWD):0,PSJPWDO=PSJPWD:PSJPWD,1:0)
+4 SET PSJSTOP=$SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,(Y<0)&'$DATA(PSGDICA):1,1:0)
+5 QUIT
+6 ;
W ;*** Select by WARD
+1 ;
+2 KILL DIC
SET DIC="^DIC(42,"
SET DIC(0)="QEAMIZ"
SET DIC("A")="Select a Ward: "
WRITE !!
DO ^DIC
+3 SET PSJSTOP=$SELECT(Y="":1,Y<0:1,$$STOP:1,1:0)
+4 IF 'PSJSTOP
SET PSGWD=+Y
SET PSGWN=Y(0,0)
DO ADMTM^PSJMDIR
if 'PSJSTOP&(PSJMDWS)
DO RBADM^PSJMDIR
+5 QUIT
+6 ;
G ;***Select by WARD GROUP
+1 ;
+2 KILL DIC
SET DIC="^PS(57.5,"
SET DIC(0)="QEAMI"
SET DIC("A")="Select a Ward Group: "
WRITE !!
+3 DO ^DIC
+4 IF Y<0
IF X="^OTHER"
SET PSJSTOP=0
SET PSGSS="C"
SET (PSGWN,PSGWGNM)="OTHER"
if PSJMDWS
DO RBADM^PSJMDIR
QUIT
+5 if $$STOP
QUIT
+6 SET PSGWG=+Y
SET PSGWGNM=$PIECE(Y,U,2)
if PSJMDWS
DO RBADM^PSJMDIR
+7 QUIT
+8 ;
+9 ;
STOP() ;
+1 ;
+2 SET PSJSTOP=$SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,$DATA(DIRUT):1,1:0)
+3 QUIT PSJSTOP
