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