source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPLBL.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1DGPLBL ;ALB/RPM - PATIENT INFORMATION LABELS ; 05/07/04
2 ;;5.3;Registration;**571**;Aug 13, 1993
3 ;
4 ;This routine provides a generic patient demographics label
5 ;print that includes Patient Name, SSN, DOB and an optional
6 ;inpatient location (ward and bed). Support for various printer
7 ;types (i.e. bar code, laser, etc.) is provided using the CONTROL
8 ;CODES (#3.2055) subfile of the TERMINAL TYPE (#3.2) file. The
9 ;control code mnemonics are documented in DBIA# 3435.
10 ;
11 Q ;no direct entry
12 ;
13EN ;main entry point used by DG PRINT PATIENT LABEL option
14 ;
15 N DGDFNS ;selected patients array
16 N DGIOCC ;control codes array
17 N DGLBCNT ;label count
18 N DGLPL ;lines per label
19 N DGLOC ;include location flag (0 or 1)
20 N DGQVAR ;queuing variables
21 ;
22 ;select list of patients to print
23 Q:'$$SELPATS("DGDFNS")
24 ;
25 S DGLOC=$$ASK("Include Inpatient Location on Label","Y","YES","Answer YES to include the inpatient ward and bed location on the label")
26 Q:(DGLOC<0)
27 ;
28 S DGLBCNT=$$ASK("Number of Labels per patient",1,"NO^1:250:0","Enter the number of labels to print per patient, from 1 to 250")
29 Q:(DGLBCNT<0)
30 ;
31 S DGLPL=$$ASK("Number of Lines per Label",6,"NO^6:25:0","Enter the total number of lines that the label stock can contain (6-25)")
32 Q:(DGLPL<0)
33 ;
34 ;
35 ;init queued variables and select output device
36 S DGQVAR("DGDFNS(")=""
37 S DGQVAR("DGLBCNT")=""
38 S DGQVAR("DGLPL")=""
39 S DGQVAR("DGLOC")=""
40 D EN^XUTMDEVQ("START^DGPLBL","DG PRINT PATIENT LABEL",.DGQVAR)
41 Q
42 ;
43START ;retrieve label field data and print labels
44 ;
45 ; Input:
46 ; DGDFNS - array subscripted by pointer to PATIENT (#2) file
47 ; DGLBCNT - number of labels to print per patient
48 ; DGLPL - number of lines per label
49 ; DGLOC - print ward location flag
50 ;
51 ; Output:
52 ; none
53 ;
54 N DGDFN ;pointer to PATIENT file
55 N DGI,DGJ ;generic counters
56 N DGIOCC ;printer Control Codes
57 N DGLN ;line array index
58 N DGLNCNT ;line count
59 N DGLINE ;line text
60 ;
61 ;initialize printer
62 S DGIOCC=$$LOADCC(.DGIOCC)
63 I DGIOCC,$G(DGIOCC("FI"))]"" X DGIOCC("FI") ;format initialize
64 ;
65 ;for each patient
66 S DGDFN=0
67 F S DGDFN=$O(DGDFNS(DGDFN)) Q:'DGDFN D
68 . ;
69 . ;build text line array
70 . S DGLNCNT=$$BLDLNAR(DGDFN,DGLOC,.DGLINE)
71 . Q:'DGLNCNT
72 . ;
73 . ;print patient's labels
74 . F DGI=1:1:DGLBCNT D
75 . . I DGIOCC,$G(DGIOCC("SL"))]"" X DGIOCC("SL") ;start of label
76 . . ;for each line
77 . . F DGLN=1:1:DGLNCNT D
78 . . . I DGIOCC,$G(DGIOCC("ST"))]"" X DGIOCC("ST") ;start text
79 . . . I DGIOCC,$G(DGIOCC("STF"))]"" X DGIOCC("STF") ;start text field
80 . . . W $G(DGLINE(DGLN))
81 . . . I DGIOCC,$G(DGIOCC("ETF"))]"" X DGIOCC("ETF") ;end text field
82 . . . I DGIOCC,$G(DGIOCC("ET"))]"" X DGIOCC("ET") ;end text
83 . . . I 'DGIOCC W !
84 . . I DGIOCC,$G(DGIOCC("EL"))]"" X DGIOCC("EL") ;end of label
85 . . I 'DGIOCC,DGLNCNT<DGLPL F DGJ=1:1:(DGLPL-DGLNCNT) W !
86 I DGIOCC,$G(DGIOCC("FE"))]"" X DGIOCC("FE") ;format end
87 ;
88 D END
89 ;
90 Q
91 ;
92SELPATS(DGARR) ;select patient(s) to print
93 ;
94 ; Input:
95 ; DGARR - array name to contain returned patients
96 ;
97 ; Output:
98 ; Function value - 1 on success; 0 on failure
99 ; DGARR - array of returned patients on success
100 ;
101 N DIC ;FM file reference
102 N VAUTVB ;contains name of subscripted variable to return
103 N VAUTNALL ;define to prevent "ALL" option
104 N VAUTSTR ;prompt string following "Select "
105 N VAUTNI ;sort type flag [1:alpha if .01 not pointer,2:numeric,
106 ; 3:alpha]
107 ;
108 S DIC="^DPT(",VAUTVB=DGARR,VAUTNALL=1,VAUTNI=2,VAUTSTR="PATIENT"
109 D FIRST^VAUTOMA
110 Q $S($O(@DGARR@("")):1,1:0)
111 ;
112 ;
113ASK(DGDIRA,DGDIRB,DGDIR0,DGDIRH) ;
114 ; Input
115 ; DGDIR0 - DIR(0) string
116 ; DGDIRA - DIR("A") string
117 ; DGDIRB - DIR("B") string
118 ; DGDIRH - DIR("?") string
119 ;
120 ; Output
121 ; Function Value - Internal value returned from ^DIR or -1 if user
122 ; up-arrows, double up-arrows or the read times out.
123 ;
124 ; DIR(0) type Results
125 ; ------------ -------------------------------
126 ; DD IEN of selected entry
127 ; Numeric Value of number entered by user
128 ; Pointer IEN of selected entry
129 ; Set of Codes Internal value of code
130 ; Yes/No 0 for No, 1 for Yes
131 ;
132 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ;^DIR variables
133 ;
134 S DIR(0)=DGDIR0
135 S DIR("A")=$G(DGDIRA)
136 I $G(DGDIRB)]"" S DIR("B")=DGDIRB
137 I $G(DGDIRH)]"" S DIR("?")=DGDIRH
138 D ^DIR
139 Q $S($D(DUOUT):-1,$D(DTOUT):-1,$D(DIROUT):-1,X="@":"@",1:$P(Y,U))
140 ;
141 ;
142LOADCC(DGIOCC) ;load control code mnemonics array
143 ; This function loads values from the CONTROL CODE (#2) subfield of
144 ; the CONTROL CODES (#55) field of the TERMINAL TYPE (#3.2) file into
145 ; an array subscripted by the CONTROL CODE ABBREVIATION (#.01) subfield
146 ; value.
147 ;
148 ; Controlled Subscription DBIA: #3435 CONTROL CODES SUBFILE
149 ;
150 ; Input:
151 ; DGIOCC - variable name to contain control codes array
152 ;
153 ; Output:
154 ; Function value - 1 when control codes exist, 0 when no control
155 ; codes exist
156 ; DGIOCC - array of control codes
157 ;
158 N DGI ;generic counter
159 N DGMNE ;control code abbreviation
160 ;
161 S DGI=0
162 F S DGI=$O(^%ZIS(2,IOST(0),55,DGI)) Q:'DGI D
163 . S DGMNE=$P($G(^%ZIS(2,IOST(0),55,DGI,0)),U)
164 . I DGMNE]"" S DGIOCC(DGMNE)=^%ZIS(2,IOST(0),55,DGI,1)
165 ;
166 Q $S('$D(DGIOCC):0,1:1)
167 ;
168BLDLNAR(DGDFN,DGLOC,DGTEXT) ;build array of text lines
169 ;
170 ; Input:
171 ; DGDFN - pointer to patient in PATIENT (#2) file
172 ; DGLOC - inpatient location flag
173 ;
174 ; Output:
175 ; Function value - count of returned lines on success; 0 on failure
176 ; DGTEXT - numeric subscripted array of label text lines
177 ;
178 N DFN,VA,VADM,VAERR ;VADPT variables
179 N DGI ;line counter
180 ;
181 S DGI=0
182 ;
183 I +$G(DGDFN),$D(^DPT(DGDFN,0)) D
184 . S DFN=DGDFN
185 . D DEM^VADPT
186 . S DGI=DGI+1
187 . S DGTEXT(DGI)="Name: "_$G(VADM(1))
188 . S DGI=DGI+1
189 . S DGTEXT(DGI)=" SSN: "_$P($G(VADM(2)),U,2)
190 . S DGI=DGI+1
191 . S DGTEXT(DGI)=" DOB: "_$$FMTE^XLFDT($P($G(VADM(3)),U),"5Z")
192 . ;WARD LOCATION and ROOM-BED
193 . S DGI=DGI+1
194 . S DGTEXT(DGI)=$S(DGLOC:"Ward: "_$S($D(^DPT(DFN,.1)):^DPT(DFN,.1)_" "_$G(^DPT(DFN,.101)),1:"UNKNOWN"),1:"")
195 ;
196 Q DGI
197 ;
198END ;cleanup and close device
199 I $D(ZTQUEUED) S ZTREQ="@"
200 E D ^%ZISC
201 Q
Note: See TracBrowser for help on using the repository browser.