DGPWBD ;ALB/CAW - Device Specifications for Patient Wristband ;2/14/95
;;5.3;Registration;**62,82,246,385,1004,1009,1015,1018**;MAY 28, 2004;Build 27
;IHS/OIT/LJF 11/04/2005 PATCH 1004 barcode will be facility code & chart #
;cmi/anch/maw 02/18/2008 PATCH 1009 requirement 3
;IHS/OIT/CLS 03/31/2015 PATCH 1018 added code at label ADD for BCMA print of wristbands
;
BL ; Barcode Blazer
N LINE
I IOST["P-TCP-ZEBR WRISTB" G ADD
U IO
S LINE=$G(^%ZIS(2,IOST(0),203)) W LINE,LINE1,!
S LINE=$G(^%ZIS(2,IOST(0),205)) W LINE,LINE2,!
S LINE=$G(^%ZIS(2,IOST(0),207)) W LINE,LINE3,!
S LINE=$G(^%ZIS(2,IOST(0),209)) W LINE,LINE4,!
;
;IHS/OIT/LJF 11/04/2005 PATCH 1004 using facility code_chart # (12 digits)
;S VARIABLE=$P(VADM(2),U)
;VARIABLE is the SSN without dashes.
S VARIABLE=$$HRCNF^BDGF2(DFN,DUZ(2))
;
I $L($G(^%ZIS(2,+IOST(0),"BAR1"))) W @^%ZIS(2,IOST(0),"BAR1")
W VARIABLE ;cmi/maw 2/18/2008 PATCH 1009 requirement 3
Q
ADD ; Add different barcode set up here
;FOXK VAOIT 3-2013,1-2014
N CPSIO,I,CPSPID1,CPSLINE,CPSPID
;PRINT 12 DIGIT HRCN ON LABEL.
S CPSPID=0 ;DEFAULTS TO NO
;GET CONTROL CODE FROM TERMINAL TYPE
S I=0 F S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I S X0=$G(^(I,0)) I X0]"" S CPSIO($P(X0,"^"))=^(1)
S CPSIO=$S('$D(CPSIO):0,1:1)
S CPSPID1=$S(DUZ("AG")="I":$$HRCNF^BDGF2(DFN,DUZ(2)),1:$$SSN^DPTLK1(DFN))
U IO
;LINES ARE DEFINED IN ^DIC(39.1, FOR WRISTBAND ITEMS.
F I="FI","SL" I $G(CPSIO(I))]"" X CPSIO(I)
;NAME
F I="SLIN1","STF" I $G(CPSIO(I))]"" X CPSIO(I)
W $E(LINE1,1,28) ;ONLY 28 LENGTH
F I="ETF","ELIN1" I $G(CPSIO(I))]"" X CPSIO(I)
W !
;HRCN
I CPSPID=1 D
.F I="SHR","STF" I $G(CPSIO(I))]"" X CPSIO(I)
.W $S(DUZ("AG")="I":+$E(CPSPID1,7,$L(CPSPID1)),1:+CPSPID1) ;STRIP ASUFAC FOR IHS ONLY
.F I="ETF","EHR" I $G(CPSIO(I))]"" X CPSIO(I)
.W !
;DO LINES 2-4
F NUM=2:1:4 D
.F I="SLIN"_NUM,"STF" I $G(CPSIO(I))]"" X CPSIO(I)
.S CPSLINE="LINE"_NUM W @CPSLINE
.F I="ETF","ELIN"_NUM I $G(CPSIO(I))]"" X CPSIO(I)
.W !
;INFANT ONLY MOTHERS NAME
I $G(CPSMOM)=1 D
.F I="SMOM","STF" I $G(CPSIO(I))]"" X CPSIO(I)
.W "Mom:"_$$GET1^DIQ(9000001,DFN,2604.2)
.F I="EMOM","ETF" I $G(CPSIO(I))]"" X CPSIO(I)
.W !
;PRINTED DT
F I="PTDT","STF" I $G(CPSIO(I))]"" X CPSIO(I)
W "Printed: "_$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3)
F I="ETF","EPTDT" I $G(CPSIO(I))]"" X CPSIO(I)
W !
;BARCODE DATA MATRIX
S:'+$G(DMCNT) DMCNT=1 ;DEFAULT TO 1 IF NOT SET
F J=1:1:DMCNT D
.F I="SBALL","SBF" I $G(CPSIO(I))]"" X CPSIO(I)
.W CPSPID1
.F I="EBF","EBALL" I $G(CPSIO(I))]"" X CPSIO(I)
.W !
F I="SB128","SBF" I $G(CPSIO(I))]"" X CPSIO(I)
W $S(DUZ("AG")="I":+$E(CPSPID1,7,$L(CPSPID1)),1:+CPSPID1) ;STRIP ASUFAC FOR IHS ONLY
F I="EBF","EB128" I $G(CPSIO(I))]"" X CPSIO(I)
W !
;END LABEL
F I="EL" I $G(CPSIO(I))]"" X CPSIO(I)
W !
D ^%ZISC
Q
DGPWBD ;ALB/CAW - Device Specifications for Patient Wristband ;2/14/95
+1 ;;5.3;Registration;**62,82,246,385,1004,1009,1015,1018**;MAY 28, 2004;Build 27
+2 ;IHS/OIT/LJF 11/04/2005 PATCH 1004 barcode will be facility code & chart #
+3 ;cmi/anch/maw 02/18/2008 PATCH 1009 requirement 3
+4 ;IHS/OIT/CLS 03/31/2015 PATCH 1018 added code at label ADD for BCMA print of wristbands
+5 ;
BL ; Barcode Blazer
+1 NEW LINE
+2 IF IOST["P-TCP-ZEBR WRISTB"
GOTO ADD
+3 USE IO
+4 SET LINE=$GET(^%ZIS(2,IOST(0),203))
WRITE LINE,LINE1,!
+5 SET LINE=$GET(^%ZIS(2,IOST(0),205))
WRITE LINE,LINE2,!
+6 SET LINE=$GET(^%ZIS(2,IOST(0),207))
WRITE LINE,LINE3,!
+7 SET LINE=$GET(^%ZIS(2,IOST(0),209))
WRITE LINE,LINE4,!
+8 ;
+9 ;IHS/OIT/LJF 11/04/2005 PATCH 1004 using facility code_chart # (12 digits)
+10 ;S VARIABLE=$P(VADM(2),U)
+11 ;VARIABLE is the SSN without dashes.
+12 SET VARIABLE=$$HRCNF^BDGF2(DFN,DUZ(2))
+13 ;
+14 IF $LENGTH($GET(^%ZIS(2,+IOST(0),"BAR1")))
WRITE @^%ZIS(2,IOST(0),"BAR1")
+15 ;cmi/maw 2/18/2008 PATCH 1009 requirement 3
WRITE VARIABLE
+16 QUIT
ADD ; Add different barcode set up here
+1 ;FOXK VAOIT 3-2013,1-2014
+2 NEW CPSIO,I,CPSPID1,CPSLINE,CPSPID
+3 ;PRINT 12 DIGIT HRCN ON LABEL.
+4 ;DEFAULTS TO NO
SET CPSPID=0
+5 ;GET CONTROL CODE FROM TERMINAL TYPE
+6 SET I=0
FOR
SET I=$ORDER(^%ZIS(2,IOST(0),55,I))
IF 'I
QUIT
SET X0=$GET(^(I,0))
IF X0]""
SET CPSIO($PIECE(X0,"^"))=^(1)
+7 SET CPSIO=$SELECT('$DATA(CPSIO):0,1:1)
+8 SET CPSPID1=$SELECT(DUZ("AG")="I":$$HRCNF^BDGF2(DFN,DUZ(2)),1:$$SSN^DPTLK1(DFN))
+9 USE IO
+10 ;LINES ARE DEFINED IN ^DIC(39.1, FOR WRISTBAND ITEMS.
+11 FOR I="FI","SL"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+12 ;NAME
+13 FOR I="SLIN1","STF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+14 ;ONLY 28 LENGTH
WRITE $EXTRACT(LINE1,1,28)
+15 FOR I="ETF","ELIN1"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+16 WRITE !
+17 ;HRCN
+18 IF CPSPID=1
Begin DoDot:1
+19 FOR I="SHR","STF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+20 ;STRIP ASUFAC FOR IHS ONLY
WRITE $SELECT(DUZ("AG")="I":+$EXTRACT(CPSPID1,7,$LENGTH(CPSPID1)),1:+CPSPID1)
+21 FOR I="ETF","EHR"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+22 WRITE !
End DoDot:1
+23 ;DO LINES 2-4
+24 FOR NUM=2:1:4
Begin DoDot:1
+25 FOR I="SLIN"_NUM,"STF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+26 SET CPSLINE="LINE"_NUM
WRITE @CPSLINE
+27 FOR I="ETF","ELIN"_NUM
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+28 WRITE !
End DoDot:1
+29 ;INFANT ONLY MOTHERS NAME
+30 IF $GET(CPSMOM)=1
Begin DoDot:1
+31 FOR I="SMOM","STF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+32 WRITE "Mom:"_$$GET1^DIQ(9000001,DFN,2604.2)
+33 FOR I="EMOM","ETF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+34 WRITE !
End DoDot:1
+35 ;PRINTED DT
+36 FOR I="PTDT","STF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+37 WRITE "Printed: "_$EXTRACT(DT,4,5),"/",$EXTRACT(DT,6,7),"/",$EXTRACT(DT,2,3)
+38 FOR I="ETF","EPTDT"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+39 WRITE !
+40 ;BARCODE DATA MATRIX
+41 ;DEFAULT TO 1 IF NOT SET
IF '+$GET(DMCNT)
SET DMCNT=1
+42 FOR J=1:1:DMCNT
Begin DoDot:1
+43 FOR I="SBALL","SBF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+44 WRITE CPSPID1
+45 FOR I="EBF","EBALL"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+46 WRITE !
End DoDot:1
+47 FOR I="SB128","SBF"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+48 ;STRIP ASUFAC FOR IHS ONLY
WRITE $SELECT(DUZ("AG")="I":+$EXTRACT(CPSPID1,7,$LENGTH(CPSPID1)),1:+CPSPID1)
+49 FOR I="EBF","EB128"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+50 WRITE !
+51 ;END LABEL
+52 FOR I="EL"
IF $GET(CPSIO(I))]""
XECUTE CPSIO(I)
+53 WRITE !
+54 DO ^%ZISC
+55 QUIT
