IBORAT1A.m

IBORAT1A ;ALB/RJS - FILTER FOR FILE 350.2 - 2/27/92

 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 ;THIS PROGRAM BUILDS A TEMP FILE FROM FILE 350.2 DATA

 ;FILE 350.2 IS THE IB ACTION CHARGE FILE

START ;

 S IBSPEC=""

 F  S IBSPEC=$O(^IBE(350.1,"E",IBSPEC)) Q:IBSPEC=""  D IBPTR

END ;

 K IBEFFDAT,IBPTR,IBRECNR,IBSPEC,IBXDATA

 Q

IBPTR ;

 S IBPTR=""

 F  S IBPTR=$O(^IBE(350.1,"E",IBSPEC,IBPTR)) Q:IBPTR=""  D IBEFFDAT

 Q

IBEFFDAT ;

 S IBEFFDAT=-9999999

 F  S IBEFFDAT=$O(^IBE(350.2,"AIVDT",IBPTR,IBEFFDAT)) Q:IBEFFDAT=""  D NEXT

 Q

NEXT ;

 F IBRECNR=0:0 S IBRECNR=$O(^IBE(350.2,"AIVDT",IBPTR,IBEFFDAT,IBRECNR)) Q:IBRECNR=""  D LOAD

 Q

LOAD ;

 SET IBXDATA=$G(^IBE(350.2,IBRECNR,0))

 I IBSPEC'=""&($P(IBXDATA,U,2)'="") S ^TMP($J,"IBORAT1A",IBSPEC,$P(IBXDATA,U,2))=$P(IBXDATA,U,4)_"^"_$P(IBXDATA,U,6)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBORAT1A   826     printed  Apr 09, 2024@21:11:09                                                                                                                                                                                                     Page 2

IBORAT1A  ;ALB/RJS - FILTER FOR FILE 350.2 - 2/27/92

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;THIS PROGRAM BUILDS A TEMP FILE FROM FILE 350.2 DATA

 +3       ;FILE 350.2 IS THE IB ACTION CHARGE FILE

START     ;

 +1        SET IBSPEC=""

 +2        FOR 

               SET IBSPEC=$ORDER(^IBE(350.1,"E",IBSPEC))

               if IBSPEC=""

                   QUIT 

               DO IBPTR

END       ;

 +1        KILL IBEFFDAT,IBPTR,IBRECNR,IBSPEC,IBXDATA

 +2        QUIT 

IBPTR     ;

 +1        SET IBPTR=""

 +2        FOR 

               SET IBPTR=$ORDER(^IBE(350.1,"E",IBSPEC,IBPTR))

               if IBPTR=""

                   QUIT 

               DO IBEFFDAT

 +3        QUIT 

IBEFFDAT  ;

 +1        SET IBEFFDAT=-9999999

 +2        FOR 

               SET IBEFFDAT=$ORDER(^IBE(350.2,"AIVDT",IBPTR,IBEFFDAT))

               if IBEFFDAT=""

                   QUIT 

               DO NEXT

 +3        QUIT 

NEXT      ;

 +1        FOR IBRECNR=0:0

               SET IBRECNR=$ORDER(^IBE(350.2,"AIVDT",IBPTR,IBEFFDAT,IBRECNR))

               if IBRECNR=""

                   QUIT 

               DO LOAD

 +2        QUIT 

LOAD      ;

 +1        SET IBXDATA=$GET(^IBE(350.2,IBRECNR,0))

 +2        IF IBSPEC'=""&($PIECE(IBXDATA,U,2)'="")

               SET ^TMP($JOB,"IBORAT1A",IBSPEC,$PIECE(IBXDATA,U,2))=$PIECE(IBXDATA,U,4)_"^"_$PIECE(IBXDATA,U,6)

 +3        QUIT