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

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1PSJMDIR1 ;BIR/MV-MED DUE WORKSHEET DIR CALLS CONT. ;17 JUN 96 / 1:40 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**111**;16 DEC 97
3 ;
4GWP(PSJMDWS) ;*** Ask for seletion from WARD GROUP,WARD,PATIENT
5 ;PSJMDWS=1 when called by Med Due Work Sheet function.
6 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): "
7 S DIR("?")="To select by PATIENT, enter a 'P'."
8 S DIR("?",1)="To select the entire WARD GROUP, enter a 'G'."
9 S DIR("?",2)="To select a single WARD, enter a 'W'."
10 W !! D ^DIR S PSJSTOP=$S(Y="":1,Y<0:1,$$STOP:1,1:0)
11 I 'PSJSTOP S PSGSS=Y D @Y
12 Q PSJSTOP
13 ;
14P ;*** Select by Patient
15 ;
16 N PSJACNWP,PSGDICA,PAGPAT S PSJACNWP=""
17 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)
18 S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,(Y<0)&'$D(PSGDICA):1,1:0)
19 Q
20 ;
21W ;*** Select by WARD
22 ;
23 K DIC S DIC="^DIC(42,",DIC(0)="QEAMIZ",DIC("A")="Select a Ward: " W !! D ^DIC
24 S PSJSTOP=$S(Y="":1,Y<0:1,$$STOP:1,1:0)
25 I 'PSJSTOP S PSGWD=+Y,PSGWN=Y(0,0) D ADMTM^PSJMDIR D:'PSJSTOP&(PSJMDWS) RBADM^PSJMDIR
26 Q
27 ;
28G ;***Select by WARD GROUP
29 ;
30 K DIC S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select a Ward Group: " W !!
31 D ^DIC
32 I Y<0,X="^OTHER" S PSJSTOP=0,PSGSS="C",(PSGWN,PSGWGNM)="OTHER" D:PSJMDWS RBADM^PSJMDIR Q
33 Q:$$STOP
34 S PSGWG=+Y,PSGWGNM=$P(Y,U,2) D:PSJMDWS RBADM^PSJMDIR
35 Q
36 ;
37 ;
38STOP() ;
39 ;
40 S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,1:0)
41 Q PSJSTOP
Note: See TracBrowser for help on using the repository browser.