- 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 Mar 13, 2025@21:38:39 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 ;
