IBCRHBR2 ;ALB/ARH - RATES: UPLOAD HOST FILES (RC) READ ; 10-OCT-1998
;;2.0;INTEGRATED BILLING;**106,138**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;LOAD -> A -> SET...
;
;for each file -> open/close and read a line -> parse the line -> save the data to XTMP
;
;
LOAD(IBPATH,IBFILE,IBNAME,PARSE,VERS) ; open and read a host file, returns true if file loaded ok
N IBOK,IBI,IBFLINE,IBSYS,X,Y S IBOK=1,IBSYS=0,VERS=$G(VERS)
;
S X=$G(^%ZOSF("OS")) I X["OpenM" S IBSYS=1,X="ERROR^IBCRHBR2",@^%ZOSF("TRAP") ; reset error trap for OpenM
;
;W !,IBNAME,?45,IBFILE ;I PARSE="OC" Q 0 ; ***** AND IBI ;Q 1
;
D OPEN^%ZISH(IBFILE,IBPATH,IBFILE,"R") I POP W !!,?20,"**** Unable to open ",IBPATH,IBFILE,! S IBOK=0 G LOADQ
;
U IO(0) W !,IBNAME,?45,IBFILE
;
S IBI=0 F S IBI=IBI+1 U IO R IBFLINE:5 Q:$$ENDF D @(PARSE_"^IBCRHBR3") I '(IBI#100) U IO(0) W "." ;Q:IBI>100
;
CLOSE D CLOSE^%ZISH(IBFILE) ;W " Done, ",(IBI-1)," lines processed."
;
LOADQ I IBSYS=1 S X="",@^%ZOSF("TRAP") ; reset error trap for OpenM
Q $G(IBOK)
;
ENDF() N IBX S IBX=1 I $T S IBX=0
I $$STATUS^%ZISH S IBX=1
Q IBX
;
ERROR ; process EOF and errors for OpenM
N IBERROR S IBERROR=$$EC^%ZOSV
I IBERROR["ENDOFFILE" S IBOK=1 G CLOSE
U IO(0) W !!,"Error reading file: ",IBERROR,!!
D ^%ZTER
S IBOK=0
G CLOSE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRHBR2 1372 printed Nov 22, 2024@17:29:20 Page 2
IBCRHBR2 ;ALB/ARH - RATES: UPLOAD HOST FILES (RC) READ ; 10-OCT-1998
+1 ;;2.0;INTEGRATED BILLING;**106,138**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;LOAD -> A -> SET...
+5 ;
+6 ;for each file -> open/close and read a line -> parse the line -> save the data to XTMP
+7 ;
+8 ;
LOAD(IBPATH,IBFILE,IBNAME,PARSE,VERS) ; open and read a host file, returns true if file loaded ok
+1 NEW IBOK,IBI,IBFLINE,IBSYS,X,Y
SET IBOK=1
SET IBSYS=0
SET VERS=$GET(VERS)
+2 ;
+3 ; reset error trap for OpenM
SET X=$GET(^%ZOSF("OS"))
IF X["OpenM"
SET IBSYS=1
SET X="ERROR^IBCRHBR2"
SET @^%ZOSF("TRAP")
+4 ;
+5 ;W !,IBNAME,?45,IBFILE ;I PARSE="OC" Q 0 ; ***** AND IBI ;Q 1
+6 ;
+7 DO OPEN^%ZISH(IBFILE,IBPATH,IBFILE,"R")
IF POP
WRITE !!,?20,"**** Unable to open ",IBPATH,IBFILE,!
SET IBOK=0
GOTO LOADQ
+8 ;
+9 USE IO(0)
WRITE !,IBNAME,?45,IBFILE
+10 ;
+11 ;Q:IBI>100
SET IBI=0
FOR
SET IBI=IBI+1
USE IO
READ IBFLINE:5
if $$ENDF
QUIT
DO @(PARSE_"^IBCRHBR3")
IF '(IBI#100)
USE IO(0)
WRITE "."
+12 ;
CLOSE ;W " Done, ",(IBI-1)," lines processed."
DO CLOSE^%ZISH(IBFILE)
+1 ;
LOADQ ; reset error trap for OpenM
IF IBSYS=1
SET X=""
SET @^%ZOSF("TRAP")
+1 QUIT $GET(IBOK)
+2 ;
ENDF() NEW IBX
SET IBX=1
IF $TEST
SET IBX=0
+1 IF $$STATUS^%ZISH
SET IBX=1
+2 QUIT IBX
+3 ;
ERROR ; process EOF and errors for OpenM
+1 NEW IBERROR
SET IBERROR=$$EC^%ZOSV
+2 IF IBERROR["ENDOFFILE"
SET IBOK=1
GOTO CLOSE
+3 USE IO(0)
WRITE !!,"Error reading file: ",IBERROR,!!
+4 DO ^%ZTER
+5 SET IBOK=0
+6 GOTO CLOSE
+7 QUIT
