- 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 Feb 18, 2025@23:45:39 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