source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJMDIR1.m@ 691

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