source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGOINPT.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1DGOINPT ;RWA/SLC,XAK/ALBANY;ALB/MLI;ALB/REW - WARD ROSTER ; 6/11/03 12:26pm
2 ;;5.3;Registration;**524**;Aug 13, 1993
3 ;;MAS VERSION 5.1;
4 ;
5 ; DGHOW = PRIMARY SORT METHOD (W=WARD P=PROVIDER)
6 ; DGPVAR= PROVIDER TYPE (P,A, OR E)
7 ; VAUTW = WARD ARRAY
8 ; DGSUBS= SECONDARY SORT METHOD (R=ROOM-BED N=NAME)
9 ; DGDS = DOUBLE SPACE: (1=YES 0=NO
10 ; DGCYPS= # OF COPIES TO PRINT
11 ; VAUTD = DIVISION VARIABLE/ARRAY
12 ;
13 D QUIT^DGOINPT1,LO^DGUTL
14 D SETUP
15 D QUIT^DGOINPT1
16 Q
17SETUP ;
18 R !!,"Sort this report by (W)ard or (P)rovider? WARD// ",X:DTIME I '$T!(X["^") Q
19 I X="" S X="W" W X
20 S Z="^WARD^PROVIDER" D IN^DGHELP
21 I %=-1 W !!?3,"Enter W to sort this report of inpatients by WARD",!?6,"or P to sort the report by PROVIDER." G SETUP
22 S DGHOW=X
23WARD I (DGHOW="W") D ASK2^SDDIV Q:Y<0 S VAUTNI=1 D WARD^VAUTOMA Q:Y<0 G NMRM
24 Q:(DGHOW'="P")
25PROV W !,"Which provider? ",!!
26 R "(P)rimary Care, (A)ttending, or (E)ITHER? EITHER// ",X:DTIME I '$T!(X["^") Q
27 I X="" S X="E" W X
28 S Z="^PRIMARY CARE^ATTENDING^EITHER" D IN^DGHELP
29 I %=-1 W !!?3,"Enter P to sort this report of inpatients by PRIMARY CARE PHYSICIAN",!?9,"A to sort the report by ATTENDING PHYSICIAN, or",!?9,"E to print the report where the provider was EITHER",!?12,"Attending or Primary Care" G PROV
30 S DGPVAR=X,VAUTNI=3
31 S DIC="^VA(200,",VAUTSTR="provider",VAUTVB="VAUTW" D FIRST^VAUTOMA
32 Q:Y<0
33NMRM ;
34 R !!,"Sub-sort by (N)ame of Patient or (R)oom NAME// ",X:DTIME I '$T!(X["^") Q
35 I X="" S X="N" W X
36 S Z="^NAME^ROOM" D IN^DGHELP
37 I %=-1 W !!,"SECONDARY SORT ORDER:",!!?3,"Enter N to sort this report of inpatients by NAME",!?6,"or R to sort the report by ROOM NUMBER.",!!?6,"Note: ROOM NUMBER = First set of numbers that appear in ROOM-BED" G NMRM
38 S DGSUBS=X
39DSP W !,"WOULD YOU LIKE THE INPATIENT ROSTER DOUBLE SPACED" S %=2 D YN^DICN Q:%<0 S DGDS='(%-1) I '% W !?4,"Enter 'Y'es to double space this report, 'N'o to single space" G DSP
40CPYS R !,"HOW MANY COPIES OF THE INPATIENT ROSTER WOULD YOU LIKE? 1//",X:DTIME Q:X="^"!'$T S:X="" X=1 I $S(X<1:1,X>10:1,1:0) W !,"Enter a number from 1 to 10 indicating the number of copies you want printed." G CPYS
41 W !!,*7,!!,"THIS REPORT REQUIRES 132 COLUMN OUTPUT"
42 S DGCPYS=X,DGPGM="ROSTER^DGOINPT1",DGVAR="VAUTD#^VAUTW#^DGPVAR^DGHOW^DGCPYS^DGDS^DGSUBS" D ZIS^DGUTQ Q:POP
43 D ROSTER^DGOINPT1
44 Q
Note: See TracBrowser for help on using the repository browser.