- ENCTREAD ;(WASH ISC)/RGY,RFJ-Upload Data from Bar Code Reader ;3.23.99
- ;;7.0;ENGINEERING;**9,35,54**;Aug 17, 1993
- READ ;
- N TIME
- D NOW^%DTC S ENCTNOW=%
- I $P(^($O(^PRCT(446.4,0)),0),"^",8)<$P(ENCTNOW,".") D TASK^ENCTPRG
- W:'$D(IOP) !!,"Enter the device to which the bar code reader is connected.",! D ^%ZIS G:POP Q1
- S ENCTEON=^%ZOSF("EON"),ENCTEOFF=^%ZOSF("EOFF"),ENCTTYPE=^%ZOSF("TYPE-AHEAD"),ENCTOPEN=$G(^%ZIS(2,IOST(0),10)),ENCTCLOS=$G(^%ZIS(2,IOST(0),11))
- U IO D OFF W !,">>> Use the TRANSMIT option on the bar code reader to start sending data:"
- D ON R X:30 I '$T D OFF W !!,"*** Error, Timeout period expired ...",!,"... No data is being received from bar code reader ***",!! G Q1
- D OFF W !," Thank you. Data is being received..."
- S TIME=$P($H,",",2)
- 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)) ;strip control chars
- I X="" W *7,!,"*** Error, an identifier was not uploaded ***",!! G Q1
- S ENCTID=+$O(^PRCT(446.4,"C",X,"")) I '$D(^PRCT(446.4,+ENCTID,0)) W !!,"*** Error, bar code data identifier '",X,"' is non-existent ***",!! G Q1
- S X=ENCTNOW
- S:'$D(^PRCT(446.4,ENCTID,2,0)) ^(0)="^446.42DI^^" S DA(1)=ENCTID,DIC="^PRCT(446.4,"_ENCTID_",2,",DIC(0)="XL",DLAYGO=446.42 F Y=0:0 D ^DIC Q:$P(Y,"^",3) S ENCTMIN=1,ENCTSD=X D ^ENCTTI S X=Y
- S ENCTTI=+Y,$P(^PRCT(446.4,ENCTID,2,+Y,0),"^",2,3)=DUZ_"^ATTEMPTING DATA UPLOAD",Y=$P(Y,"^",2) X ^DD("DD")
- W !!,"OK, You are logging data on ",Y," ...",!," ... using the BARCODE program ",$P(^PRCT(446.4,ENCTID,0),"^"),!!,"Reading barcode reader ..."
- 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,ENCTID,2,ENCTTI,1,Y+1,0)=X D DOTS
- R %:1 ;clear buffer
- D OFF S ^PRCT(446.4,ENCTID,2,ENCTTI,1,0)="^^"_Y_"^"_Y_"^"_$P(ENCTNOW,".") 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 ^ENCTMES1 S $P(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD FAILURE" G READ K ^(1) G READ
- S $P(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
- I $P(^PRCT(446.4,ENCTID,0),"^",3)]"" S X=$P(^(0),"^",3) D RTN^ENCTUTL,NORTN^ENCTMES1:'$D(X) S:'$D(X) $P(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="POST UPLOAD RTN MISSING" G:'$D(X) Q1 D Q11 G @($P(X,"-")_"^"_$P(X,"-",2))
- W !!,"*** OK, transmission of data successful !",!,"You can purge the files on the barcode reader if you wish.",! K ZTDTH D TASK
- Q1 K ENCTID,ENCTTI
- Q11 D ^%ZISC
- K DIC,DA,DLAYGO,ZTSK,POP,ENCTCLOS,ENCTEOFF,ENCTEON,ENCTNOW,ENCTOPEN,ENCTTYPE
- Q
- ;
- TASK ;Tasks an appropriate processor routine, needs ENCTID and ENCTTI
- ;If ZTDTH is undefined, time will be set automatically, If ZTDTH=-1, time will be asked.
- S ENCT=$S('$D(ENCTID):0,$D(^PRCT(446.4,ENCTID,0))#2:^(0),1:0) I ENCT=0 W *7 D NONID^ENCTMES1 G Q3
- I $S('$D(ENCTTI):1,1:'$D(^PRCT(446.4,ENCTID,2,ENCTTI,0))#2) W *7 D NOTI^ENCTMES1 G Q3
- S ZTRTN="DEQUE^ENCTMAN",ZTIO="" I $P(ENCT,"^",6) D DEV G:POP Q3
- I '$D(ZTDTH) D NOW^%DTC S ENCT=$P(ENCT,"^",5),X=$S(ENCT="":"N",%#1>+("."_ENCT):"T+1@"_ENCT,1:"T@"_ENCT),%DT="XTR" D ^%DT S ZTDTH=Y
- K:ZTDTH<0 ZTDTH S (ZTSAVE("ENCTID"),ZTSAVE("ENCTTI"))="",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,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL" $P(^(0),"^",3)="NOT QUEUED" G Q3
- W !!,"OK, the data collected on " S Y=+$P(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^") X ^DD("DD") W Y,!,"for ",$P(^PRCT(446.4,ENCTID,0),"^")," will be processed on "
- S Y=ZTDTH X ^DD("DD") W Y,! S $P(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="TASKED FOR "_Y
- D ^%ZTLOAD
- Q3 K ENCT,POP,ENCTID,ENCTTI,ZTDTH,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTIO Q
- DEV ;
- W !,"QUEUE TO PRINT ON" S %ZIS="NQ" D ^%ZIS I 'POP S ZTIO=IO,IOP=ION D ^%ZIS Q
- W *7 D NODEV^ENCTMES1 S X="Are you sure you do NOT want to select a device ?^N" D ENYN^ENCTQUES I X="^"!X S:$P(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL" $P(^(0),"^",3)="DEVICE NOT SELECTED",POP=1 Q
- G DEV
- DOTS ;Act ind
- I IO=IO(0) D OFF
- U IO(0) W "." U IO
- I IO=IO(0) D ON
- Q
- ;
- ON ;
- X ENCTOPEN U IO X ENCTEOFF,ENCTTYPE
- Q
- OFF ;
- X ENCTCLOS,ENCTEON U IO(0)
- Q
- ;ENCTREAD
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENCTREAD 4365 printed Feb 18, 2025@23:18:41 Page 2
- ENCTREAD ;(WASH ISC)/RGY,RFJ-Upload Data from Bar Code Reader ;3.23.99
- +1 ;;7.0;ENGINEERING;**9,35,54**;Aug 17, 1993
- READ ;
- +1 NEW TIME
- +2 DO NOW^%DTC
- SET ENCTNOW=%
- +3 IF $PIECE(^($ORDER(^PRCT(446.4,0)),0),"^",8)<$PIECE(ENCTNOW,".")
- DO TASK^ENCTPRG
- +4 if '$DATA(IOP)
- WRITE !!,"Enter the device to which the bar code reader is connected.",!
- DO ^%ZIS
- if POP
- GOTO Q1
- +5 SET ENCTEON=^%ZOSF("EON")
- SET ENCTEOFF=^%ZOSF("EOFF")
- SET ENCTTYPE=^%ZOSF("TYPE-AHEAD")
- SET ENCTOPEN=$GET(^%ZIS(2,IOST(0),10))
- SET ENCTCLOS=$GET(^%ZIS(2,IOST(0),11))
- +6 USE IO
- DO OFF
- WRITE !,">>> Use the TRANSMIT option on the bar code reader to start sending data:"
- +7 DO ON
- READ X:30
- IF '$TEST
- DO OFF
- WRITE !!,"*** Error, Timeout period expired ...",!,"... No data is being received from bar code reader ***",!!
- GOTO Q1
- +8 DO OFF
- WRITE !," Thank you. Data is being received..."
- +9 SET TIME=$PIECE($HOROLOG,",",2)
- +10 ;strip control chars
- 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))
- +11 IF X=""
- WRITE *7,!,"*** Error, an identifier was not uploaded ***",!!
- GOTO Q1
- +12 SET ENCTID=+$ORDER(^PRCT(446.4,"C",X,""))
- IF '$DATA(^PRCT(446.4,+ENCTID,0))
- WRITE !!,"*** Error, bar code data identifier '",X,"' is non-existent ***",!!
- GOTO Q1
- +13 SET X=ENCTNOW
- +14 if '$DATA(^PRCT(446.4,ENCTID,2,0))
- SET ^(0)="^446.42DI^^"
- SET DA(1)=ENCTID
- SET DIC="^PRCT(446.4,"_ENCTID_",2,"
- SET DIC(0)="XL"
- SET DLAYGO=446.42
- FOR Y=0:0
- DO ^DIC
- if $PIECE(Y,"^",3)
- QUIT
- SET ENCTMIN=1
- SET ENCTSD=X
- DO ^ENCTTI
- SET X=Y
- +15 SET ENCTTI=+Y
- SET $PIECE(^PRCT(446.4,ENCTID,2,+Y,0),"^",2,3)=DUZ_"^ATTEMPTING DATA UPLOAD"
- SET Y=$PIECE(Y,"^",2)
- XECUTE ^DD("DD")
- +16 WRITE !!,"OK, You are logging data on ",Y," ...",!," ... using the BARCODE program ",$PIECE(^PRCT(446.4,ENCTID,0),"^"),!!,"Reading barcode reader ..."
- +17 DO ON
- FOR Y=0:1
- READ X:10
- SET X=$TRANSLATE(X,$CHAR(10))
- if $EXTRACT(X,1,9)="***END***"!'$TEST
- QUIT
- Begin DoDot:1
- +18 ; check for blank lines (Open-M problem)
- IF X=""
- SET Y=Y-1
- QUIT
- +19 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,Y+1,0)=X
- DO DOTS
- End DoDot:1
- +20 ;clear buffer
- READ %:1
- +21 DO OFF
- SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,0)="^^"_Y_"^"_Y_"^"_$PIECE(ENCTNOW,".")
- WRITE !,"Data transmission complete. Number of records read: ",Y
- +22 WRITE !!,"Upload time: "_($PIECE($HOROLOG,",",2)-TIME)_" sec."
- +23 IF Y'=$PIECE(X,"^",2)
- WRITE *7
- SET MES="REC"
- DO ^ENCTMES1
- SET $PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD FAILURE"
- GOTO READ
- KILL ^(1)
- GOTO READ
- +24 SET $PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
- +25 IF $PIECE(^PRCT(446.4,ENCTID,0),"^",3)]""
- SET X=$PIECE(^(0),"^",3)
- DO RTN^ENCTUTL
- if '$DATA(X)
- DO NORTN^ENCTMES1
- if '$DATA(X)
- SET $PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="POST UPLOAD RTN MISSING"
- if '$DATA(X)
- GOTO Q1
- DO Q11
- GOTO @($PIECE(X,"-")_"^"_$PIECE(X,"-",2))
- +26 WRITE !!,"*** OK, transmission of data successful !",!,"You can purge the files on the barcode reader if you wish.",!
- KILL ZTDTH
- DO TASK
- Q1 KILL ENCTID,ENCTTI
- Q11 DO ^%ZISC
- +1 KILL DIC,DA,DLAYGO,ZTSK,POP,ENCTCLOS,ENCTEOFF,ENCTEON,ENCTNOW,ENCTOPEN,ENCTTYPE
- +2 QUIT
- +3 ;
- TASK ;Tasks an appropriate processor routine, needs ENCTID and ENCTTI
- +1 ;If ZTDTH is undefined, time will be set automatically, If ZTDTH=-1, time will be asked.
- +2 SET ENCT=$SELECT('$DATA(ENCTID):0,$DATA(^PRCT(446.4,ENCTID,0))#2:^(0),1:0)
- IF ENCT=0
- WRITE *7
- DO NONID^ENCTMES1
- GOTO Q3
- +3 IF $SELECT('$DATA(ENCTTI):1,1:'$DATA(^PRCT(446.4,ENCTID,2,ENCTTI,0))#2)
- WRITE *7
- DO NOTI^ENCTMES1
- GOTO Q3
- +4 SET ZTRTN="DEQUE^ENCTMAN"
- SET ZTIO=""
- IF $PIECE(ENCT,"^",6)
- DO DEV
- if POP
- GOTO Q3
- +5 IF '$DATA(ZTDTH)
- DO NOW^%DTC
- SET ENCT=$PIECE(ENCT,"^",5)
- SET X=$SELECT(ENCT="":"N",%#1>+("."_ENCT):"T+1@"_ENCT,1:"T@"_ENCT)
- SET %DT="XTR"
- DO ^%DT
- SET ZTDTH=Y
- +6 if ZTDTH<0
- KILL ZTDTH
- SET (ZTSAVE("ENCTID"),ZTSAVE("ENCTTI"))=""
- SET ZTDESC="Barcode data processor"
- +7 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,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
- SET $PIECE(^(0),"^",3)="NOT QUEUED"
- GOTO Q3
- +8 WRITE !!,"OK, the data collected on "
- SET Y=+$PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^")
- XECUTE ^DD("DD")
- WRITE Y,!,"for ",$PIECE(^PRCT(446.4,ENCTID,0),"^")," will be processed on "
- +9 SET Y=ZTDTH
- XECUTE ^DD("DD")
- WRITE Y,!
- SET $PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="TASKED FOR "_Y
- +10 DO ^%ZTLOAD
- Q3 KILL ENCT,POP,ENCTID,ENCTTI,ZTDTH,ZTDESC,ZTRTN,ZTSAVE,ZTSK,ZTIO
- QUIT
- DEV ;
- +1 WRITE !,"QUEUE TO PRINT ON"
- SET %ZIS="NQ"
- DO ^%ZIS
- IF 'POP
- SET ZTIO=IO
- SET IOP=ION
- DO ^%ZIS
- QUIT
- +2 WRITE *7
- DO NODEV^ENCTMES1
- SET X="Are you sure you do NOT want to select a device ?^N"
- DO ENYN^ENCTQUES
- IF X="^"!X
- if $PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),"^",3)="DATA UPLOAD SUCCESSFUL"
- SET $PIECE(^(0),"^",3)="DEVICE NOT SELECTED"
- SET POP=1
- QUIT
- +3 GOTO DEV
- DOTS ;Act ind
- +1 IF IO=IO(0)
- DO OFF
- +2 USE IO(0)
- WRITE "."
- USE IO
- +3 IF IO=IO(0)
- DO ON
- +4 QUIT
- +5 ;
- ON ;
- +1 XECUTE ENCTOPEN
- USE IO
- XECUTE ENCTEOFF
- XECUTE ENCTTYPE
- +2 QUIT
- OFF ;
- +1 XECUTE ENCTCLOS
- XECUTE ENCTEON
- USE IO(0)
- +2 QUIT
- +3 ;ENCTREAD