IBY196PO.m

IBY196PO ;ALB/TMK - IB*2*196 POST-INSTALL ;06-AUG-2002

 ;;2.0;INTEGRATED BILLING;**196**;21-MAR-94

 ;

POST ;Set up check points for post-install

 S %=$$NEWCP^XPDUTL("BATCH","BATCH^IBY196PO")

 Q

 ;

BATCH N %,Z,IBCT,IBDA,IBSAVE,IBBILL,IB,IB0,IBACC,DA,DIE,X,Y,DR,Z

 D BMES^XPDUTL("Updating batches with Austin Confirmation status")

 ; Logic: Read through all the batches in file 364.1

 ;  If the batch is not in RECEIVED IN AUSTIN status (A0), check if any

 ;  of the bills in that batch have an A0, A1 or A2 status.  This

 ;  will indicate the batch was received in Austin and the status

 ;  of the batch is wrong.  If this is the case, update the batch

 ;  status to A0 and update the status of any of the bills in the

 ;  batch that still have a 'P' status to A0.

 S (IBCT,IBDA)=0

 F  S IBDA=$O(^IBA(364.1,IBDA)) Q:'IBDA  I $P($G(^IBA(364.1,IBDA,0)),U,2)="P" D

 . ; Find bills in the batch

 . K IBSAVE S IBACC=0

 . S IBBILL=0 F  S IBBILL=$O(^IBA(364,"C",IBDA,IBBILL)) Q:'IBBILL  S IB0=$G(^IBA(364,IBBILL,0)) I IB0'="" D

 .. S IB=$P(IB0,U,3) ; Bill status

 .. I IB["A" S IBACC=1 Q  ; Accepted by Austin, non-payer or payer

 .. I IB="P" S IBSAVE(IBBILL)="" ; Still pending confirmation

 . I IBACC D

 .. S IBCT=IBCT+1

 .. S DR=".02////A0",DIE="^IBA(364.1,",DA=IBDA D ^DIE

 .. S Z=0 F  S Z=$O(IBSAVE(Z)) Q:'Z  I $P($G(^IBA(364,Z,0)),U,3)="P" S DR=".03////A0",DIE="^IBA(364,",DA=Z D ^DIE

 D BMES^XPDUTL("Post install complete - "_IBCT_" batches updated")

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBY196PO   1487     printed  Apr 09, 2024@21:09:50                                                                                                                                                                                                    Page 2

IBY196PO  ;ALB/TMK - IB*2*196 POST-INSTALL ;06-AUG-2002

 +1       ;;2.0;INTEGRATED BILLING;**196**;21-MAR-94

 +2       ;

POST      ;Set up check points for post-install

 +1        SET %=$$NEWCP^XPDUTL("BATCH","BATCH^IBY196PO")

 +2        QUIT 

 +3       ;

BATCH      NEW %,Z,IBCT,IBDA,IBSAVE,IBBILL,IB,IB0,IBACC,DA,DIE,X,Y,DR,Z

 +1        DO BMES^XPDUTL("Updating batches with Austin Confirmation status")

 +2       ; Logic: Read through all the batches in file 364.1

 +3       ;  If the batch is not in RECEIVED IN AUSTIN status (A0), check if any

 +4       ;  of the bills in that batch have an A0, A1 or A2 status.  This

 +5       ;  will indicate the batch was received in Austin and the status

 +6       ;  of the batch is wrong.  If this is the case, update the batch

 +7       ;  status to A0 and update the status of any of the bills in the

 +8       ;  batch that still have a 'P' status to A0.

 +9        SET (IBCT,IBDA)=0

 +10       FOR 

               SET IBDA=$ORDER(^IBA(364.1,IBDA))

               if 'IBDA

                   QUIT 

               IF $PIECE($GET(^IBA(364.1,IBDA,0)),U,2)="P"

                   Begin DoDot:1

 +11      ; Find bills in the batch

 +12                   KILL IBSAVE

                       SET IBACC=0

 +13                   SET IBBILL=0

                       FOR 

                           SET IBBILL=$ORDER(^IBA(364,"C",IBDA,IBBILL))

                           if 'IBBILL

                               QUIT 

                           SET IB0=$GET(^IBA(364,IBBILL,0))

                           IF IB0'=""

                               Begin DoDot:2

 +14      ; Bill status

                                   SET IB=$PIECE(IB0,U,3)

 +15      ; Accepted by Austin, non-payer or payer

                                   IF IB["A"

                                       SET IBACC=1

                                       QUIT 

 +16      ; Still pending confirmation

                                   IF IB="P"

                                       SET IBSAVE(IBBILL)=""

                               End DoDot:2

 +17                   IF IBACC

                           Begin DoDot:2

 +18                           SET IBCT=IBCT+1

 +19                           SET DR=".02////A0"

                               SET DIE="^IBA(364.1,"

                               SET DA=IBDA

                               DO ^DIE

 +20                           SET Z=0

                               FOR 

                                   SET Z=$ORDER(IBSAVE(Z))

                                   if 'Z

                                       QUIT 

                                   IF $PIECE($GET(^IBA(364,Z,0)),U,3)="P"

                                       SET DR=".03////A0"

                                       SET DIE="^IBA(364,"

                                       SET DA=Z

                                       DO ^DIE

                           End DoDot:2

                   End DoDot:1

 +21       DO BMES^XPDUTL("Post install complete - "_IBCT_" batches updated")

 +22       QUIT 

 +23      ;