- IBY189PO ;ALB/TMK - IB*2*189 POST-INSTALL ;06-AUG-2002
- ;;2.0;INTEGRATED BILLING;**189**;21-MAR-94
- ;
- POST ;Set up check points for post-init
- S %=$$NEWCP^XPDUTL("U36","U36^IBY189PO")
- Q
- ;
- U36 N %,Z,IBDA,IBCT,IBCTX,DA,DIE,X,Y,DR
- D BMES^XPDUTL("Deleting bad EDI IDs from Insurance Company file")
- S IBDA=+$$PARCP^XPDUTL("U36"),IBCT=0,IBCTX=0
- F S IBDA=$O(^DIC(36,IBDA)) Q:'IBDA S Z=$G(^(IBDA,3)),IBCT=IBCT+1 D
- . S DR=""
- . I $P(Z,U,2)=36330!($P(Z,U,2)="PAYID") S DR="3.02///@",IBCTX=IBCTX+1
- . I $P(Z,U,4)=36330!($P(Z,U,4)="PAYID") S DR=DR_$S(DR="":"",1:";")_"3.04///@",IBCTX=IBCTX+1
- . I DR'="" S DIE="^DIC(36,",DA=IBDA D ^DIE
- . I IBCT=20 S %=$$UPCP^XPDUTL("U36",IBDA),IBCT=0
- D BMES^XPDUTL("Post install complete - "_IBCTX_" ID(s) deleted.")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY189PO 774 printed Feb 18, 2025@23:59:56 Page 2
- IBY189PO ;ALB/TMK - IB*2*189 POST-INSTALL ;06-AUG-2002
- +1 ;;2.0;INTEGRATED BILLING;**189**;21-MAR-94
- +2 ;
- POST ;Set up check points for post-init
- +1 SET %=$$NEWCP^XPDUTL("U36","U36^IBY189PO")
- +2 QUIT
- +3 ;
- U36 NEW %,Z,IBDA,IBCT,IBCTX,DA,DIE,X,Y,DR
- +1 DO BMES^XPDUTL("Deleting bad EDI IDs from Insurance Company file")
- +2 SET IBDA=+$$PARCP^XPDUTL("U36")
- SET IBCT=0
- SET IBCTX=0
- +3 FOR
- SET IBDA=$ORDER(^DIC(36,IBDA))
- if 'IBDA
- QUIT
- SET Z=$GET(^(IBDA,3))
- SET IBCT=IBCT+1
- Begin DoDot:1
- +4 SET DR=""
- +5 IF $PIECE(Z,U,2)=36330!($PIECE(Z,U,2)="PAYID")
- SET DR="3.02///@"
- SET IBCTX=IBCTX+1
- +6 IF $PIECE(Z,U,4)=36330!($PIECE(Z,U,4)="PAYID")
- SET DR=DR_$SELECT(DR="":"",1:";")_"3.04///@"
- SET IBCTX=IBCTX+1
- +7 IF DR'=""
- SET DIE="^DIC(36,"
- SET DA=IBDA
- DO ^DIE
- +8 IF IBCT=20
- SET %=$$UPCP^XPDUTL("U36",IBDA)
- SET IBCT=0
- End DoDot:1
- +9 DO BMES^XPDUTL("Post install complete - "_IBCTX_" ID(s) deleted.")
- +10 QUIT
- +11 ;