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 Dec 13, 2024@02:33:28 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 ;
