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 ---[H[J[2J[HIBORAT1A 826 printed Dec 13, 2024@02:25:59 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
