IBCRHBS2.m

IBCRHBS2 ;ALB/ARH - RATES: UPLOAD HOST FILES (RC 2+) READ ; 10-OCT-03

 ;;2.0;INTEGRATED BILLING;**245**;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,COLUMNS) ; 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) I '$G(COLUMNS) S IBOK=0 G LOADQ

 ;

 S X=$G(^%ZOSF("OS")) I X["OpenM" S IBSYS=1,X="ERROR^IBCRHBS2",@^%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_"^IBCRHBS3") 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 ---IBCRHBS2   1409     printed  Apr 09, 2024@21:26:13                                                                                                                                                                                                    Page 2

IBCRHBS2  ;ALB/ARH - RATES: UPLOAD HOST FILES (RC 2+) READ ; 10-OCT-03

 +1       ;;2.0;INTEGRATED BILLING;**245**;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,COLUMNS) ; 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)

           IF '$GET(COLUMNS)

               SET IBOK=0

               GOTO LOADQ

 +2       ;

 +3       ; reset error trap for OpenM

           SET X=$GET(^%ZOSF("OS"))

           IF X["OpenM"

               SET IBSYS=1

               SET X="ERROR^IBCRHBS2"

               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_"^IBCRHBS3")

               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