IBORAT1B.m

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 ---IBORAT1B   1029     printed  Apr 09, 2024@21:35:33                                                                                                                                                                                                    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