IBORAT1B ;ALB/RJS - DATE SETUP IBROUTINE  - 3/02/92
 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
 ;CALLED BY IBORAT1A
 ;THIS IBROUTINE PARSES A TMP FILE CONTAINING DATA FROM FILES
 ;350.2 AND CALCULATES BEGINNING AND ENDING DATES
 ;FOR BILLING RATES AND MEDICARE DEDUCTIBLES.
 ;EG. IF RATE IS EFFECTIVE ON 1/1/87 AND IS SUPERSEDED BY A NEW RATE
 ;ON 1/1/88 IT IS IN EFFECT FROM 1/1/87-12/31/87
 ;THIS DATA IS STORED IN ^TMP($J,IBROUT,IBSPEC,IBEFFDAT)=IBCANCEL^AMOUNT
 ;OUTPUT BY IBORAT4
 ;
START ;
 S IBROUT="IBORAT1A",IBSPEC=""
 F  S IBSPEC=$O(^TMP($J,IBROUT,IBSPEC)) Q:IBSPEC=""  D IBSPEC2
END ;
 K IBCANCEL,IBEFFDAT,IBROUT,IBSPEC,X,X1,X2
 Q
IBSPEC2 ;
 S IBEFFDAT=-1
 F  S IBEFFDAT=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT)) Q:IBEFFDAT=""  D IBCANCEL
 Q
IBCANCEL ;
 S IBCANCEL=$O(^TMP($J,IBROUT,IBSPEC,IBEFFDAT))
 I IBCANCEL="" D CANDATE2 Q
 S X1=IBCANCEL,X2=-1 D C^%DTC
 S ^TMP($J,IBROUT,IBSPEC,IBEFFDAT)=X_"^"_^(IBEFFDAT)
 Q
CANDATE2 ;
 S ^TMP($J,IBROUT,IBSPEC,IBEFFDAT)=9999999_"^"_^(IBEFFDAT)
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBORAT1B   1029     printed  Sep 23, 2025@20:02:19                                                                                                                                                                                                    Page 2
IBORAT1B  ;ALB/RJS - DATE SETUP IBROUTINE  - 3/02/92
 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
 +2       ;CALLED BY IBORAT1A
 +3       ;THIS IBROUTINE PARSES A TMP FILE CONTAINING DATA FROM FILES
 +4       ;350.2 AND CALCULATES BEGINNING AND ENDING DATES
 +5       ;FOR BILLING RATES AND MEDICARE DEDUCTIBLES.
 +6       ;EG. IF RATE IS EFFECTIVE ON 1/1/87 AND IS SUPERSEDED BY A NEW RATE
 +7       ;ON 1/1/88 IT IS IN EFFECT FROM 1/1/87-12/31/87
 +8       ;THIS DATA IS STORED IN ^TMP($J,IBROUT,IBSPEC,IBEFFDAT)=IBCANCEL^AMOUNT
 +9       ;OUTPUT BY IBORAT4
 +10      ;
START     ;
 +1        SET IBROUT="IBORAT1A"
           SET IBSPEC=""
 +2        FOR 
               SET IBSPEC=$ORDER(^TMP($JOB,IBROUT,IBSPEC))
               if IBSPEC=""
                   QUIT 
               DO IBSPEC2
END       ;
 +1        KILL IBCANCEL,IBEFFDAT,IBROUT,IBSPEC,X,X1,X2
 +2        QUIT 
IBSPEC2   ;
 +1        SET IBEFFDAT=-1
 +2        FOR 
               SET IBEFFDAT=$ORDER(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT))
               if IBEFFDAT=""
                   QUIT 
               DO IBCANCEL
 +3        QUIT 
IBCANCEL  ;
 +1        SET IBCANCEL=$ORDER(^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT))
 +2        IF IBCANCEL=""
               DO CANDATE2
               QUIT 
 +3        SET X1=IBCANCEL
           SET X2=-1
           DO C^%DTC
 +4        SET ^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT)=X_"^"_^(IBEFFDAT)
 +5        QUIT 
CANDATE2  ;
 +1        SET ^TMP($JOB,IBROUT,IBSPEC,IBEFFDAT)=9999999_"^"_^(IBEFFDAT)
 +2        QUIT