| [613] | 1 | DGPWB ;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 | ;
|
|---|
| 5 | EN ; 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)
|
|---|
| 17 | ENQ K DTOUT,DUOUT Q
|
|---|
| 18 | ;
|
|---|
| 19 | START(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)
|
|---|
| 26 | TRANS 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
|
|---|
| 33 | DIV 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
|
|---|
| 39 | STARTQ Q
|
|---|
| 40 | ;
|
|---|
| 41 | DIVISION(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 | ;
|
|---|
| 51 | SET ;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 | ;
|
|---|
| 81 | PID ;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 | ;
|
|---|
| 88 | END ;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 | ;
|
|---|
| 94 | PRINT ; Print the wristband
|
|---|
| 95 | ;
|
|---|
| 96 | ; Change call from BL to whatever device is added in DGPWBD
|
|---|
| 97 | ;
|
|---|
| 98 | D BL^DGPWBD
|
|---|
| 99 | Q
|
|---|
| 100 | ;
|
|---|
| 101 | DEVICE() ;
|
|---|
| 102 | S Y=0
|
|---|
| 103 | DEVEN 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
|
|---|
| 108 | DEVICEQ Q Y
|
|---|
| 109 | ;
|
|---|
| 110 | QUE() ; -- 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 | ;
|
|---|
| 119 | TRCHK(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
|
|---|
| 125 | TRCHKQ Q Y
|
|---|
| 126 | ;
|
|---|
| 127 | ASK() ;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
|
|---|
| 131 | ASKQ Q Y
|
|---|
