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

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1DGPWB ;ALB/CAW/MLR - Patient Wristband Print ; 9/27/00 3:40pm
2 ;;5.3;Registration;**62,82,287**;Aug 13, 1993
3 ; -**287** Substituting SS# when Primary long ID missing in .36
4 ;
5EN ; Ask patient name
6 ; This is used when printing a wristband from the menu
7 ;
8 N DFN,VAIN,VAERR,DIC,Y,OPTIND
9 S OPTIND=0
10 S DIC(0)="AEMQZ",DIC="^DPT("
11 D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) G ENQ
12 S DFN=+Y D INP^VADPT
13 S:'$G(VAIN(4)) OPTIND=1
14 I $G(VAIN(4)),('$$DIVISION($P(VAIN(4),U))) W !,"Printing Wristbands for inpatients at this division is set to no." G ENQ
15 I OPTIND S Y=$$DEVICE() G:'Y!(Y>1) ENQ D SET G ENQ
16 D START(DFN)
17ENQ K DTOUT,DUOUT Q
18 ;
19START(DFN) ;Start
20 ; This is where it will be used when in admit or transfer
21 ; Input is patient IFN
22 ;
23 N WARD,DIVISION,PRINT,Y
24 D INP^VADPT I '$G(VAIN(4)) G STARTQ
25 S WARD=+VAIN(4)
26TRANS I $G(DGPMA),'$$TRCHK($P(DGPMA,U,18)) G STARTQ
27 ; Check to see if no change was made on edit
28 I $D(DGPMA),$D(DGPMP),$P(DGPMA,U,18)=41 N Y D G DIV:Y
29 .S Y=$O(^UTILITY("DGPM",$J,2,"")) Q:'Y
30 .I $P(^UTILITY("DGPM",$J,2,Y,"P"),U,6)=$P(^UTILITY("DGPM",$J,2,Y,"A"),U,6) S Y=0
31 I $D(DGPMA),$D(DGPMP),($P(DGPMA,U,6)=$P(DGPMP,U,6)) G STARTQ
32 ; Check to see if division parameter to print wristband is on
33DIV I '$$DIVISION(WARD) G STARTQ
34 I $G(DGPMA),'$$ASK G STARTQ
35 ; Prompt for device - quit if device is not selected or is queued
36 S Y=$$DEVICE() I 'Y!(Y>1) G STARTQ
37 ; Set up lines to print
38 D SET
39STARTQ Q
40 ;
41DIVISION(WARD) ; Obtain Divison from Ward Location
42 ;
43 N Y,DIVISION
44 S Y=0
45 ; Print Patient Wristband parameter
46 S DIVISION=$P($G(^DIC(42,+WARD,0)),U,11)
47 I '$P(^DG(43,1,"GL"),U,2) S DIVISION=$O(^DG(40.8,0))
48 I $P($G(^DG(40.8,+DIVISION,0)),U,8)="Y" S Y=1
49 Q Y
50 ;
51SET ;Set the lines to print
52 ;This is where taskman will start when job is queued.
53 ; Input needed is DFN and WARD (WARD is set to IFN of WARD LOCATION)
54 ;
55 N CNT,BAND,DATA,FINAL,IFN,ITEMD,LINE,X,WHERE
56 D DEM^VADPT
57 ;
58 ; If a different wristband is going to be used-change name in "B" x-ref
59 ;
60 S LINE=0 S IFN=$O(^DIC(39.1,"B","WRISTBAND",0)) Q:'IFN
61 F S LINE=$O(^DIC(39.1,IFN,1,LINE)) Q:'LINE D
62 .S DATA=0 F S DATA=$O(^DIC(39.1,IFN,1,LINE,1,DATA)) Q:'DATA D
63 ..S ITEMD=^DIC(39.1,IFN,1,LINE,1,DATA,0)
64 ..S X=$G(^DIC(39.2,+ITEMD,1)) X X
65 ..;
66 ..;Checking for PID# and substituting SS# if missing **287**
67 ..I Y="",$G(^DIC(39.2,+ITEMD,0))="PID" D PID
68 ..;
69 ..S BAND(LINE,-DATA)=$E(Y,1,$P(ITEMD,U,3))_"^"_$P(ITEMD,U,2)
70 .S WHERE="" F S WHERE=$O(BAND(LINE,WHERE)) Q:'WHERE D
71 ..I $D(BAND(LINE,(WHERE+1))) S $P(BAND(LINE,WHERE),U,2)=($P(BAND(LINE,WHERE),U,2))-($L($P(BAND(LINE,(WHERE+1)),U)))
72 ..S $P(FINAL(LINE)," ",$P(BAND(LINE,WHERE),U,2))=$P(BAND(LINE,WHERE),U)
73 F CNT=1:1:99 Q:'$D(FINAL(CNT)) S X="LINE"_CNT S @X=FINAL(CNT)
74 D PRINT
75 D:'$D(ZTQUEUED) ^%ZISC
76 ; This is where the call to update the allergy file
77 S X="GMRAMCU0" X ^%ZOSF("TEST") I $T D IDBAND^GMRAMCU0(DFN,DT,DUZ)
78 D END
79 Q
80 ;
81PID ;Substituting SS# for missing PID# **287** MLR
82 S Y=$P($G(^DPT(DFN,0)),U,9)
83 D
84 . I Y S Y=$E(Y,1,3)_" "_$E(Y,4,5)_" "_$E(Y,6,$L(Y)) Q
85 . S Y="NO ID FOUND" Q
86 Q ;PID
87 ;
88END ;Clean up variables
89 K VARIABLE
90 N CNT,VAR
91 F CNT=1:1:99 S VAR="LINE"_CNT Q:'$D(@VAR) K @VAR
92 Q
93 ;
94PRINT ; Print the wristband
95 ;
96 ; Change call from BL to whatever device is added in DGPWBD
97 ;
98 D BL^DGPWBD
99 Q
100 ;
101DEVICE() ;
102 S Y=0
103DEVEN S %ZIS="Q",%ZIS("A")="PRINT WRISTBAND ON DEVICE: ",%ZIS("B")=""
104 D ^%ZIS I POP G DEVICEQ
105 I $E(IOST,1,2)'["P-" W !,"A printer must be selected." G DEVEN
106 I '$D(IO("Q")) S Y=1 G DEVICEQ
107 S Y=$$QUE
108DEVICEQ Q Y
109 ;
110QUE() ; -- que job
111 ; return: did job que [ 1|yes 0|no ]
112 ;
113 K ZTSK,IO("Q")
114 S ZTDESC="Patient Wristband Print",ZTRTN="SET^DGPWB"
115 F X="WARD","DFN" S ZTSAVE(X)=""
116 D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
117 Q $D(ZTSK)
118 ;
119TRCHK(TYPE) ;Check to see if appropriate type to continue
120 ;
121 N MVMT,Y
122 S Y=0
123 S MVMT=$P($G(^DG(405.2,+TYPE,0)),U,2) I MVMT=1 S Y=1 G TRCHKQ
124 I "^4^13^14^22^23^24^41^44^45^"[(U_TYPE_U) S Y=1
125TRCHKQ Q Y
126 ;
127ASK() ;Ask if they want to print
128 W ! S DIR("A")="Do you want to print a Patient Wristband"
129 S DIR(0)="Y",DIR("B")="YES"
130 D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) S Y=0
131ASKQ Q Y
Note: See TracBrowser for help on using the repository browser.