IBY189PO.m

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 ---IBY189PO   774     printed  Apr 09, 2024@21:21:45                                                                                                                                                                                                     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      ;