PRCTREAD ;WISC@ALTOONA/RGY,RFJ-READ DATA FROM BAR CODE READER ;6.29.98
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
READ ; upload from portable bar code reader
N PRCTCLOS,PRCTEOFF,PRCTEON,PRCTNOW,PRCTOPEN,PRCTTYPE,TIME
D NOW^%DTC S PRCTNOW=%
S PRCTID=+$O(^PRCT(446.4,0))
I $P($G(^PRCT(446.4,PRCTID,0)),"^",8)<$P(PRCTNOW,".") D TASK^PRCTPRG
W:'$D(IOP) !!,"Enter the device to which the bar code reader is connected.",! D ^%ZIS I POP D Q1 Q
S PRCTEON=^%ZOSF("EON"),PRCTEOFF=^%ZOSF("EOFF"),PRCTTYPE=^%ZOSF("TYPE-AHEAD"),PRCTOPEN=$G(^%ZIS(2,IOST(0),10)),PRCTCLOS=$G(^%ZIS(2,IOST(0),11)) S:PRCTOPEN="" PRCTOPEN="W """"" S:PRCTCLOS="" PRCTCLOS="W """""
U IO D OFF W !,">>> Use the TRANSMIT option on the barcode reader to start sending the data:"
D ON
READ1 R X:30 I '$T D OFF W !," *** Error, NO data received from bar code reader within 30 seconds ***",!! G Q1
G:X="" READ1
D OFF W !," Thank You ! Data is being received ..." D ON
S TIME=$P($H,",",2)
;strip off control characters
S X=$TR(X,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
I X="" D OFF W !," *** Error, an identifier was not entered ***",!! G Q1
S PRCTID=+$O(^PRCT(446.4,"C",X,"")) I '$D(^PRCT(446.4,+PRCTID,0)) D OFF W !," *** Error, bar code data identifier '",X,"' is non-existent ***",!! G Q1
S X=PRCTNOW S:'$D(^PRCT(446.4,PRCTID,2,0)) ^(0)="^446.42DI^^" S DA(1)=PRCTID,DIC="^PRCT(446.4,"_PRCTID_",2,",DIC(0)="XL",DLAYGO=446.4 F Y=0:0 D ^DIC Q:$P(Y,"^",3) S PRCTMIN=1,PRCTSD=X D ^PRCTTI S X=Y
S PRCTTI=+Y,$P(^PRCT(446.4,PRCTID,2,+Y,0),"^",2,3)=DUZ_"^ATTEMPTING DATA UPLOAD",Y=$P(Y,"^",2) D DD^%DT
D OFF W !!,"<<< Reading records for ",$P(^PRCT(446.4,PRCTID,0),"^"),",",!?14,"logged on ",Y," ..." D ON
F Y=0:1 R X:10 S X=$TR(X,$C(10)) Q:$E(X,1,9)="***END***"!'$T D
. I X="" S Y=Y-1 Q ; check for blank lines (Open-M problem)
. S ^PRCT(446.4,PRCTID,2,PRCTTI,1,Y+1,0)=X
;clear buffer
R %:1
D OFF S ^PRCT(446.4,PRCTID,2,PRCTTI,1,0)="^^"_Y_"^"_Y_"^"_$P(PRCTNOW,".") W !," Data transmission complete, number of records read: ",Y
W !!,"Upload time: "_($P($H,",",2)-TIME)_" sec."
I Y'=$P(X,"^",2) W *7 S MES="REC" D ^PRCTMES1 S $P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD FAILURE" G READ
S $P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
I $P(^PRCT(446.4,PRCTID,0),"^",3)]"" S X=$P(^(0),"^",3) D RTN^PRCTUTL,NORTN^PRCTMES1:'$D(X) S:'$D(X) $P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="POST UPLOAD RTN MISSING" G:'$D(X) Q1 D Q11 G @($P(X,"-")_"^"_$P(X,"-",2))
W !!,"<<< Transmission of data successful! >>>",!," You can purge the files on the bar code reader if you wish.",! K ZTDTH D TASK
Q1 K PRCTID,PRCTTI
Q11 D ^%ZISC S IOP=ION D ^%ZIS K IOP,DIC,DA,DLAYGO,ZTSK,POP,%DT,D Q
TASK ;Tasks an appropriate barcode processor to taskman, needs PRCTID and PRCTTI
;If routine is PRCPBALM, process the data on line.
;If ZTDTH is undefined, time will be set automatically, If ZTDTH=-1, time will be asked or ZTDTH= valied $H or Fileman format
S PRCT=$S('$D(PRCTID):0,$D(^PRCT(446.4,PRCTID,0))#2:^(0),1:0) I PRCT=0 W *7 D NONID^PRCTMES1 G Q3
I $S('$D(PRCTTI):1,1:'$D(^PRCT(446.4,PRCTID,2,PRCTTI,0))#2) W *7 D NOTI^PRCTMES1 G Q3
S %=$TR($P(PRCT,"^",4),"-","^") I %["PRCPBALM" D @% K %,X,Y,ZTDTH G Q3
S ZTRTN="DEQUE^PRCTMAN",ZTIO="" I $P(PRCT,"^",6) D DEV G:POP Q3
I '$D(ZTDTH) D NOW^%DTC S PRCT=$P(PRCT,"^",5),X=$S(PRCT="":"N",%#1>+("."_PRCT):"T+1@"_PRCT,1:"T@"_PRCT),%DT="XTR" D ^%DT S ZTDTH=Y
K:ZTDTH<0 ZTDTH S (ZTSAVE("PRCTID"),ZTSAVE("PRCTTI"))="",ZTDESC="Barcode data processor"
I '$D(ZTDTH) S %DT="XTRA",%DT("A")="Request time to process: ",%DT("B")="NOW" D ^%DT S ZTDTH=Y I Y<0 W !,"* Data will NOT be processed *",! S:$P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL" $P(^(0),"^",3)="NOT QUEUED" G Q3
W !!,"OK, the data collected on " S Y=+$P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^") D DD^%DT W Y,!,"for ",$P(^PRCT(446.4,PRCTID,0),"^")," will be processed on "
S Y=ZTDTH D DD^%DT W Y,! S $P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="TASKED FOR "_Y
D ^%ZTLOAD
Q3 K PRCT,POP,PRCTID,PRCTTI Q
DEV ;
W !,"QUEUE TO PRINT ON" S %ZIS="NQ" D ^%ZIS I 'POP S IOP=ION D ^%ZIS Q
W *7 D NODEV^PRCTMES1 S X="Are you sure you do NOT want to select a device ?^N" D ENYN^PRCTQUES I X="^"!X S:$P(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL" $P(^(0),"^",3)="DEVICE NOT SELECTED",POP=1 Q
G DEV
OFF ;
X PRCTCLOS,PRCTEON U IO(0) Q
ON ;
X PRCTOPEN U IO X PRCTEOFF,PRCTTYPE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCTREAD 4576 printed Nov 22, 2024@17:29:29 Page 2
PRCTREAD ;WISC@ALTOONA/RGY,RFJ-READ DATA FROM BAR CODE READER ;6.29.98
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
READ ; upload from portable bar code reader
+1 NEW PRCTCLOS,PRCTEOFF,PRCTEON,PRCTNOW,PRCTOPEN,PRCTTYPE,TIME
+2 DO NOW^%DTC
SET PRCTNOW=%
+3 SET PRCTID=+$ORDER(^PRCT(446.4,0))
+4 IF $PIECE($GET(^PRCT(446.4,PRCTID,0)),"^",8)<$PIECE(PRCTNOW,".")
DO TASK^PRCTPRG
+5 if '$DATA(IOP)
WRITE !!,"Enter the device to which the bar code reader is connected.",!
DO ^%ZIS
IF POP
DO Q1
QUIT
+6 SET PRCTEON=^%ZOSF("EON")
SET PRCTEOFF=^%ZOSF("EOFF")
SET PRCTTYPE=^%ZOSF("TYPE-AHEAD")
SET PRCTOPEN=$GET(^%ZIS(2,IOST(0),10))
SET PRCTCLOS=$GET(^%ZIS(2,IOST(0),11))
if PRCTOPEN=""
SET PRCTOPEN="W """""
if PRCTCLOS=""
SET PRCTCLOS="W """""
+7 USE IO
DO OFF
WRITE !,">>> Use the TRANSMIT option on the barcode reader to start sending the data:"
+8 DO ON
READ1 READ X:30
IF '$TEST
DO OFF
WRITE !," *** Error, NO data received from bar code reader within 30 seconds ***",!!
GOTO Q1
+1 if X=""
GOTO READ1
+2 DO OFF
WRITE !," Thank You ! Data is being received ..."
DO ON
+3 SET TIME=$PIECE($HOROLOG,",",2)
+4 ;strip off control characters
+5 SET X=$TRANSLATE(X,$CHAR(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
+6 IF X=""
DO OFF
WRITE !," *** Error, an identifier was not entered ***",!!
GOTO Q1
+7 SET PRCTID=+$ORDER(^PRCT(446.4,"C",X,""))
IF '$DATA(^PRCT(446.4,+PRCTID,0))
DO OFF
WRITE !," *** Error, bar code data identifier '",X,"' is non-existent ***",!!
GOTO Q1
+8 SET X=PRCTNOW
if '$DATA(^PRCT(446.4,PRCTID,2,0))
SET ^(0)="^446.42DI^^"
SET DA(1)=PRCTID
SET DIC="^PRCT(446.4,"_PRCTID_",2,"
SET DIC(0)="XL"
SET DLAYGO=446.4
FOR Y=0:0
DO ^DIC
if $PIECE(Y,"^",3)
QUIT
SET PRCTMIN=1
SET PRCTSD=X
DO ^PRCTTI
SET X=Y
+9 SET PRCTTI=+Y
SET $PIECE(^PRCT(446.4,PRCTID,2,+Y,0),"^",2,3)=DUZ_"^ATTEMPTING DATA UPLOAD"
SET Y=$PIECE(Y,"^",2)
DO DD^%DT
+10 DO OFF
WRITE !!,"<<< Reading records for ",$PIECE(^PRCT(446.4,PRCTID,0),"^"),",",!?14,"logged on ",Y," ..."
DO ON
+11 FOR Y=0:1
READ X:10
SET X=$TRANSLATE(X,$CHAR(10))
if $EXTRACT(X,1,9)="***END***"!'$TEST
QUIT
Begin DoDot:1
+12 ; check for blank lines (Open-M problem)
IF X=""
SET Y=Y-1
QUIT
+13 SET ^PRCT(446.4,PRCTID,2,PRCTTI,1,Y+1,0)=X
End DoDot:1
+14 ;clear buffer
+15 READ %:1
+16 DO OFF
SET ^PRCT(446.4,PRCTID,2,PRCTTI,1,0)="^^"_Y_"^"_Y_"^"_$PIECE(PRCTNOW,".")
WRITE !," Data transmission complete, number of records read: ",Y
+17 WRITE !!,"Upload time: "_($PIECE($HOROLOG,",",2)-TIME)_" sec."
+18 IF Y'=$PIECE(X,"^",2)
WRITE *7
SET MES="REC"
DO ^PRCTMES1
SET $PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD FAILURE"
GOTO READ
+19 SET $PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
+20 IF $PIECE(^PRCT(446.4,PRCTID,0),"^",3)]""
SET X=$PIECE(^(0),"^",3)
DO RTN^PRCTUTL
if '$DATA(X)
DO NORTN^PRCTMES1
if '$DATA(X)
SET $PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="POST UPLOAD RTN MISSING"
if '$DATA(X)
GOTO Q1
DO Q11
GOTO @($PIECE(X,"-")_"^"_$PIECE(X,"-",2))
+21 WRITE !!,"<<< Transmission of data successful! >>>",!," You can purge the files on the bar code reader if you wish.",!
KILL ZTDTH
DO TASK
Q1 KILL PRCTID,PRCTTI
Q11 DO ^%ZISC
SET IOP=ION
DO ^%ZIS
KILL IOP,DIC,DA,DLAYGO,ZTSK,POP,%DT,D
QUIT
TASK ;Tasks an appropriate barcode processor to taskman, needs PRCTID and PRCTTI
+1 ;If routine is PRCPBALM, process the data on line.
+2 ;If ZTDTH is undefined, time will be set automatically, If ZTDTH=-1, time will be asked or ZTDTH= valied $H or Fileman format
+3 SET PRCT=$SELECT('$DATA(PRCTID):0,$DATA(^PRCT(446.4,PRCTID,0))#2:^(0),1:0)
IF PRCT=0
WRITE *7
DO NONID^PRCTMES1
GOTO Q3
+4 IF $SELECT('$DATA(PRCTTI):1,1:'$DATA(^PRCT(446.4,PRCTID,2,PRCTTI,0))#2)
WRITE *7
DO NOTI^PRCTMES1
GOTO Q3
+5 SET %=$TRANSLATE($PIECE(PRCT,"^",4),"-","^")
IF %["PRCPBALM"
DO @%
KILL %,X,Y,ZTDTH
GOTO Q3
+6 SET ZTRTN="DEQUE^PRCTMAN"
SET ZTIO=""
IF $PIECE(PRCT,"^",6)
DO DEV
if POP
GOTO Q3
+7 IF '$DATA(ZTDTH)
DO NOW^%DTC
SET PRCT=$PIECE(PRCT,"^",5)
SET X=$SELECT(PRCT="":"N",%#1>+("."_PRCT):"T+1@"_PRCT,1:"T@"_PRCT)
SET %DT="XTR"
DO ^%DT
SET ZTDTH=Y
+8 if ZTDTH<0
KILL ZTDTH
SET (ZTSAVE("PRCTID"),ZTSAVE("PRCTTI"))=""
SET ZTDESC="Barcode data processor"
+9 IF '$DATA(ZTDTH)
SET %DT="XTRA"
SET %DT("A")="Request time to process: "
SET %DT("B")="NOW"
DO ^%DT
SET ZTDTH=Y
IF Y<0
WRITE !,"* Data will NOT be processed *",!
if $PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
SET $PIECE(^(0),"^",3)="NOT QUEUED"
GOTO Q3
+10 WRITE !!,"OK, the data collected on "
SET Y=+$PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^")
DO DD^%DT
WRITE Y,!,"for ",$PIECE(^PRCT(446.4,PRCTID,0),"^")," will be processed on "
+11 SET Y=ZTDTH
DO DD^%DT
WRITE Y,!
SET $PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="TASKED FOR "_Y
+12 DO ^%ZTLOAD
Q3 KILL PRCT,POP,PRCTID,PRCTTI
QUIT
DEV ;
+1 WRITE !,"QUEUE TO PRINT ON"
SET %ZIS="NQ"
DO ^%ZIS
IF 'POP
SET IOP=ION
DO ^%ZIS
QUIT
+2 WRITE *7
DO NODEV^PRCTMES1
SET X="Are you sure you do NOT want to select a device ?^N"
DO ENYN^PRCTQUES
IF X="^"!X
if $PIECE(^PRCT(446.4,PRCTID,2,PRCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
SET $PIECE(^(0),"^",3)="DEVICE NOT SELECTED"
SET POP=1
QUIT
+3 GOTO DEV
OFF ;
+1 XECUTE PRCTCLOS
XECUTE PRCTEON
USE IO(0)
QUIT
ON ;
+1 XECUTE PRCTOPEN
USE IO
XECUTE PRCTEOFF
XECUTE PRCTTYPE
QUIT
