- 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 Feb 18, 2025@23:52:28 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