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 ---[H[J[2J[HIBY196PO 1487 printed Oct 16, 2024@18:34:05 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 ;
