IBY447PO ;ALB/GEF - Post-Installation for IB patch 447 ;19-APR-2011
;;2.0;INTEGRATED BILLING;**447**;19-APR-11;Build 80
D RIT,TPB,CRD
Q
;
RIT ; recompile billing screen templates
N X,Y,DMAX,IBN
D MES^XPDUTL("Recompiling Input Templates for Billing Screens ...")
F IBN=1:1:9,"10","102","10H" D
.S X="IBXS"_$S(IBN=10:"A",IBN="102":"A2",IBN="10H":"AH",1:IBN)
.S Y=$$FIND1^DIC(.402,,"X","IB SCREEN"_IBN,"B")
.S DMAX=$$ROUSIZE^DILF
.I Y D EN^DIEZ
D MES^XPDUTL(" Done.")
Q
;
TPB ; Change THIRD PARTY BILLING menu mnemonic
NEW MENUIEN,ITEMIEN,STOP,IBX,DIE,DA,DR
D MES^XPDUTL("Updating THIRD PARTY BILLING menu mnemonic ....")
;
S MENUIEN=$O(^DIC(19,"B","IB BILLING CLERK MENU",0)) D UBCG
S MENUIEN=$O(^DIC(19,"B","IB BILLING SUPERVISOR MENU",0)) D UBCG
Q
;
UBCG ;
Q:'MENUIEN
S ITEMIEN=0 F S ITEMIEN=$O(^DIC(19,MENUIEN,10,ITEMIEN)) Q:'ITEMIEN D
. S IBX=$P($G(^DIC(19,MENUIEN,10,ITEMIEN,0)),U,2) Q:$E(IBX,1,2)'="UB"
. S DIE="^DIC(19,"_MENUIEN_",10,"
. S DA=ITEMIEN,DA(1)=MENUIEN
. S DR="2////TPB"
. D ^DIE
Q
CRD ; fix mis-match between claim and account number from patch 433
N IBN,IBDT,IBC,IBAR,X
; Start with install date of patch 433
S X=$$INSTALDT^XPDUTL("IB*2.0*433",.IBDT) Q:X<1
S IBDT=$P($O(IBDT("")),".")
S IBDT=IBDT-1 F S IBDT=$O(^DGCR(399,"APD",IBDT)) Q:'IBDT D
.S IBN=0 F S IBN=$O(^DGCR(399,"APD",IBDT,IBN)) Q:'IBN D
..; only look at claims with iteration numbers
..S IBC=$P($G(^DGCR(399,IBN,0)),"^") Q:IBC'["-"
..S IBAR=$P($P($G(^PRCA(430,IBN,0)),"^"),"-",2,3)
..Q:IBC=IBAR
..; claim does not match AR, fix claim
..S $P(^DGCR(399,IBN,0),"^")=IBAR,^DGCR(399,"B",IBAR,IBN)=""
..K ^DGCR(399,"B",IBC,IBN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY447PO 1704 printed Oct 16, 2024@18:34:47 Page 2
IBY447PO ;ALB/GEF - Post-Installation for IB patch 447 ;19-APR-2011
+1 ;;2.0;INTEGRATED BILLING;**447**;19-APR-11;Build 80
+2 DO RIT
DO TPB
DO CRD
+3 QUIT
+4 ;
RIT ; recompile billing screen templates
+1 NEW X,Y,DMAX,IBN
+2 DO MES^XPDUTL("Recompiling Input Templates for Billing Screens ...")
+3 FOR IBN=1:1:9,"10","102","10H"
Begin DoDot:1
+4 SET X="IBXS"_$SELECT(IBN=10:"A",IBN="102":"A2",IBN="10H":"AH",1:IBN)
+5 SET Y=$$FIND1^DIC(.402,,"X","IB SCREEN"_IBN,"B")
+6 SET DMAX=$$ROUSIZE^DILF
+7 IF Y
DO EN^DIEZ
End DoDot:1
+8 DO MES^XPDUTL(" Done.")
+9 QUIT
+10 ;
TPB ; Change THIRD PARTY BILLING menu mnemonic
+1 NEW MENUIEN,ITEMIEN,STOP,IBX,DIE,DA,DR
+2 DO MES^XPDUTL("Updating THIRD PARTY BILLING menu mnemonic ....")
+3 ;
+4 SET MENUIEN=$ORDER(^DIC(19,"B","IB BILLING CLERK MENU",0))
DO UBCG
+5 SET MENUIEN=$ORDER(^DIC(19,"B","IB BILLING SUPERVISOR MENU",0))
DO UBCG
+6 QUIT
+7 ;
UBCG ;
+1 if 'MENUIEN
QUIT
+2 SET ITEMIEN=0
FOR
SET ITEMIEN=$ORDER(^DIC(19,MENUIEN,10,ITEMIEN))
if 'ITEMIEN
QUIT
Begin DoDot:1
+3 SET IBX=$PIECE($GET(^DIC(19,MENUIEN,10,ITEMIEN,0)),U,2)
if $EXTRACT(IBX,1,2)'="UB"
QUIT
+4 SET DIE="^DIC(19,"_MENUIEN_",10,"
+5 SET DA=ITEMIEN
SET DA(1)=MENUIEN
+6 SET DR="2////TPB"
+7 DO ^DIE
End DoDot:1
+8 QUIT
CRD ; fix mis-match between claim and account number from patch 433
+1 NEW IBN,IBDT,IBC,IBAR,X
+2 ; Start with install date of patch 433
+3 SET X=$$INSTALDT^XPDUTL("IB*2.0*433",.IBDT)
if X<1
QUIT
+4 SET IBDT=$PIECE($ORDER(IBDT("")),".")
+5 SET IBDT=IBDT-1
FOR
SET IBDT=$ORDER(^DGCR(399,"APD",IBDT))
if 'IBDT
QUIT
Begin DoDot:1
+6 SET IBN=0
FOR
SET IBN=$ORDER(^DGCR(399,"APD",IBDT,IBN))
if 'IBN
QUIT
Begin DoDot:2
+7 ; only look at claims with iteration numbers
+8 SET IBC=$PIECE($GET(^DGCR(399,IBN,0)),"^")
if IBC'["-"
QUIT
+9 SET IBAR=$PIECE($PIECE($GET(^PRCA(430,IBN,0)),"^"),"-",2,3)
+10 if IBC=IBAR
QUIT
+11 ; claim does not match AR, fix claim
+12 SET $PIECE(^DGCR(399,IBN,0),"^")=IBAR
SET ^DGCR(399,"B",IBAR,IBN)=""
+13 KILL ^DGCR(399,"B",IBC,IBN)
End DoDot:2
End DoDot:1
+14 QUIT
