IBY432PO ;ALB/GEF - Post-Installation for IB patch 432 ;3-Oct-2010
;;2.0;INTEGRATED BILLING;**432**;21-MAR-94;Build 192
;
; check the names in file 355.1 to get ready for IB*2.0*447
D NMCK
; do post-init from Patch 418 which was merged into our patch
D PO418
D RIT
D ADDUSR
D VC
D TURNITON
D INSFLAG
D KILLPEB
Q
;
RIT ; recompile billing screen templates
N X,Y,DMAX,IBN
D MES^XPDUTL("Recompiling Input Templates for Billing Screens ...")
F IBN=1:1:5,"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
;
ADDUSR ;IA#4677;This will add user if it's not there
N IEN200
S IEN200=$$CREATE^XUSAP("AUTHORIZER,IB REG","")
Q:+IEN200=0 ; already exists
Q:+IEN200>0 ; added the user successfully
I IEN200<0 Q ; problem adding the new user. May want to let someone know.
Q
;
PO418 ; post-init for Patch 418
Q:$$INSTALDT^XPDUTL("IB*2.0*432")>1 ;DBIA#10141
N U S U="^"
D TAXADD
Q
;
TAXADD ;Taxonomy code IEN in subfile 399.0222 (field .15/piece 15) if no exist
;IBSTUS - the bill status=1 (entered/not reviewed)
;IBEVDT - the outpatient event date or (inpatient admission date)
;IBPRV - IEN in new person file 200
;
N DA,DA2,NUM,REC,REC2,IBSTUS,IBILL,IBTAX,IBEVDT,IBPRV
S DA=0,NUM=0
D MES^XPDUTL("Adding Taxonomy code IEN to file (#399)....")
F S DA=$O(^DGCR(399,DA)) Q:'DA D
. S REC=$G(^DGCR(399,DA,0)),IBSTUS=$P(REC,U,13)
. Q:IBSTUS'=1
. S DA2=0,IBILL=$P(REC,U),IBEVDT=$P(REC,U,3)
. F S DA2=$O(^DGCR(399,DA,"PRV",DA2)) Q:'DA2 D
.. S REC2=$G(^DGCR(399,DA,"PRV",DA2,0))
.. S IBPRV=$P(REC2,U,2),IBTAX=$P(REC2,U,15)
.. Q:IBTAX'=""!($P(IBPRV,";",2)'="VA(200,")
.. S IBTAX=$P($$GET^XUA4A72(+IBPRV,IBEVDT),U,1)
.. Q:IBTAX'>0
.. S $P(^DGCR(399,DA,"PRV",DA2,0),U,15)=IBTAX
.. S IBPRV=$P($G(^VA(200,+IBPRV,0)),U)
.. D MES^XPDUTL(" Taxonomy code IEN "_IBTAX_" for provider "_IBPRV_" added to bill# "_IBILL)
.. S NUM=NUM+1
D MES^XPDUTL("Total "_NUM_$S(NUM=1:" bill has",1:" bills have")_" been updated")
D MES^XPDUTL("")
Q
;
VC ;Mark Value Codes A3, B3, and C3 obsolete so that the user will not be able to enter them on the billing screens
D BMES^XPDUTL("Marking Value Codes A3, B3, and C3 obsolete... ")
N DA,DIE,DR,TODAY,X,Y,VC
S TODAY=$G(DT) I TODAY="" D NOW^%DTC S TODAY=X
S DR=".26////"_TODAY
S DIE=399.1
F VC="A3","B3","C3" D
. S DA=""
. F S DA=$O(^DGCR(399.1,"C",VC,DA)) Q:'DA D
.. I '$$GET1^DIQ(399.1,DA,.18,"I") Q ;Not a value code
.. I $$GET1^DIQ(399.1,DA,.26,"I") Q ;Already marked Obsolete
.. D MES^XPDUTL(" IEN - "_DA)
.. D ^DIE
D MES^XPDUTL(" Done.")
D MES^XPDUTL("")
Q
;
TURNITON ;
N DIE,DA,DR,DIC,D0
S DIE=350.9,DA=1,DR="8.17///YES" D ^DIE
Q
;
INSFLAG ; Set new field to YES
N INSCO
S INSCO=0 F S INSCO=$O(^DIC(36,INSCO)) Q:'+INSCO D
. Q:($$GET1^DIQ(36,INSCO,6.1))]"" ; don't set if a value is already there
. N X,Y,DA,DIE,DR
. S DA=INSCO
. S DIE=36
. S DR="6.1///YES"
. D ^DIE
Q
;
NMCK ; Check to make sure that names in file 355.1 have not been edited at site.
; this is in preparation for IB*2.0*447 (TCR15) which will be updating some entries in that file.
Q:$$INSTALDT^XPDUTL("IB*2.0*432")>1 ;DBIA#10141
N DATA,IEN,ERR,LN
F LN=2:1:12 D
.S DATA=$P($T(NM3551+LN),";;",2) Q:DATA=""
.S IEN=$O(^IBE(355.1,"B",$P(DATA,U,2),""))
.S:IEN="" ERR(LN)=" "_$P(DATA,U,2)
D:$D(ERR) BULL(.ERR)
Q
;
BULL(ERR) ; send mail bulletin if there was a problem with file 355.1
;
N DIFROM,XMDUZ,XMTEXT,XMY,XMSUB,L,SITE,IBTXT,I
S SITE=$P($$SITE^VASITE,U,2)
S XMSUB="Problem w/ TYPE OF PLAN (file #355.1) at "_SITE
S XMDUZ=.5,XMTEXT="IBTXT("
K XMY S XMY("GRACE.FIAMENGO@DOMAIN.EXT")=""
S IBTXT(1)="During the pre-install check for IB*2.0*447 there was a problem with one or"
S IBTXT(2)="more names in the TYPE OF PLAN file (#355.1) at: "_SITE
S IBTXT(3)=""
S IBTXT(4)="The Name Check in IBY432PO did not find an exact match for the following: "
S L=5 F I=2:1:12 I $D(ERR(I)) S L=L+1,IBTXT(L)=ERR(I)
D ^XMD
Q
;
NM3551 ; entries in file 355.1 to be checked
;
;;^CARVE-OUT^
;;^COMPREHENSIVE MAJOR MEDICAL^
;;^MEDICAL EXPENSE (OPT/PROF)^
;;^MEDICARE SECONDARY^
;;^MEDIGAP (SUPPLEMENTAL)^
;;^MEDIGAP (SUPPL - COINS, DED, PART B EXC)^
;;^MENTAL HEALTH^
;;^POINT OF SERVICE^
;;^PREFERRED PROVIDER ORGANIZATION (PPO)^
;;^RETIREE^
;;^SURGICAL EXPENSE INSURANCE^
;
Q
;
KILLPEB ; Designed to remove the "Print EOB" option from the "IBCE 837 EDI REPORTS" menu.
N MENUIEN,ITEMIEN,DIK,DA
S MENUIEN=$O(^DIC(19,"B","IBCE 837 EDI REPORTS",0)) Q:MENUIEN=""
S ITEMIEN=$O(^DIC(19,MENUIEN,10,"C","PEB",0)) Q:ITEMIEN=""
S DIK="^DIC(19,"_MENUIEN_",10,"
S DA=ITEMIEN,DA(1)=MENUIEN
D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY432PO 4895 printed Apr 09, 2024@21:17:39 Page 2
IBY432PO ;ALB/GEF - Post-Installation for IB patch 432 ;3-Oct-2010
+1 ;;2.0;INTEGRATED BILLING;**432**;21-MAR-94;Build 192
+2 ;
+3 ; check the names in file 355.1 to get ready for IB*2.0*447
+4 DO NMCK
+5 ; do post-init from Patch 418 which was merged into our patch
+6 DO PO418
+7 DO RIT
+8 DO ADDUSR
+9 DO VC
+10 DO TURNITON
+11 DO INSFLAG
+12 DO KILLPEB
+13 QUIT
+14 ;
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:5,"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 ;
ADDUSR ;IA#4677;This will add user if it's not there
+1 NEW IEN200
+2 SET IEN200=$$CREATE^XUSAP("AUTHORIZER,IB REG","")
+3 ; already exists
if +IEN200=0
QUIT
+4 ; added the user successfully
if +IEN200>0
QUIT
+5 ; problem adding the new user. May want to let someone know.
IF IEN200<0
QUIT
+6 QUIT
+7 ;
PO418 ; post-init for Patch 418
+1 ;DBIA#10141
if $$INSTALDT^XPDUTL("IB*2.0*432")>1
QUIT
+2 NEW U
SET U="^"
+3 DO TAXADD
+4 QUIT
+5 ;
TAXADD ;Taxonomy code IEN in subfile 399.0222 (field .15/piece 15) if no exist
+1 ;IBSTUS - the bill status=1 (entered/not reviewed)
+2 ;IBEVDT - the outpatient event date or (inpatient admission date)
+3 ;IBPRV - IEN in new person file 200
+4 ;
+5 NEW DA,DA2,NUM,REC,REC2,IBSTUS,IBILL,IBTAX,IBEVDT,IBPRV
+6 SET DA=0
SET NUM=0
+7 DO MES^XPDUTL("Adding Taxonomy code IEN to file (#399)....")
+8 FOR
SET DA=$ORDER(^DGCR(399,DA))
if 'DA
QUIT
Begin DoDot:1
+9 SET REC=$GET(^DGCR(399,DA,0))
SET IBSTUS=$PIECE(REC,U,13)
+10 if IBSTUS'=1
QUIT
+11 SET DA2=0
SET IBILL=$PIECE(REC,U)
SET IBEVDT=$PIECE(REC,U,3)
+12 FOR
SET DA2=$ORDER(^DGCR(399,DA,"PRV",DA2))
if 'DA2
QUIT
Begin DoDot:2
+13 SET REC2=$GET(^DGCR(399,DA,"PRV",DA2,0))
+14 SET IBPRV=$PIECE(REC2,U,2)
SET IBTAX=$PIECE(REC2,U,15)
+15 if IBTAX'=""!($PIECE(IBPRV,";",2)'="VA(200,")
QUIT
+16 SET IBTAX=$PIECE($$GET^XUA4A72(+IBPRV,IBEVDT),U,1)
+17 if IBTAX'>0
QUIT
+18 SET $PIECE(^DGCR(399,DA,"PRV",DA2,0),U,15)=IBTAX
+19 SET IBPRV=$PIECE($GET(^VA(200,+IBPRV,0)),U)
+20 DO MES^XPDUTL(" Taxonomy code IEN "_IBTAX_" for provider "_IBPRV_" added to bill# "_IBILL)
+21 SET NUM=NUM+1
End DoDot:2
End DoDot:1
+22 DO MES^XPDUTL("Total "_NUM_$SELECT(NUM=1:" bill has",1:" bills have")_" been updated")
+23 DO MES^XPDUTL("")
+24 QUIT
+25 ;
VC ;Mark Value Codes A3, B3, and C3 obsolete so that the user will not be able to enter them on the billing screens
+1 DO BMES^XPDUTL("Marking Value Codes A3, B3, and C3 obsolete... ")
+2 NEW DA,DIE,DR,TODAY,X,Y,VC
+3 SET TODAY=$GET(DT)
IF TODAY=""
DO NOW^%DTC
SET TODAY=X
+4 SET DR=".26////"_TODAY
+5 SET DIE=399.1
+6 FOR VC="A3","B3","C3"
Begin DoDot:1
+7 SET DA=""
+8 FOR
SET DA=$ORDER(^DGCR(399.1,"C",VC,DA))
if 'DA
QUIT
Begin DoDot:2
+9 ;Not a value code
IF '$$GET1^DIQ(399.1,DA,.18,"I")
QUIT
+10 ;Already marked Obsolete
IF $$GET1^DIQ(399.1,DA,.26,"I")
QUIT
+11 DO MES^XPDUTL(" IEN - "_DA)
+12 DO ^DIE
End DoDot:2
End DoDot:1
+13 DO MES^XPDUTL(" Done.")
+14 DO MES^XPDUTL("")
+15 QUIT
+16 ;
TURNITON ;
+1 NEW DIE,DA,DR,DIC,D0
+2 SET DIE=350.9
SET DA=1
SET DR="8.17///YES"
DO ^DIE
+3 QUIT
+4 ;
INSFLAG ; Set new field to YES
+1 NEW INSCO
+2 SET INSCO=0
FOR
SET INSCO=$ORDER(^DIC(36,INSCO))
if '+INSCO
QUIT
Begin DoDot:1
+3 ; don't set if a value is already there
if ($$GET1^DIQ(36,INSCO,6.1))]""
QUIT
+4 NEW X,Y,DA,DIE,DR
+5 SET DA=INSCO
+6 SET DIE=36
+7 SET DR="6.1///YES"
+8 DO ^DIE
End DoDot:1
+9 QUIT
+10 ;
NMCK ; Check to make sure that names in file 355.1 have not been edited at site.
+1 ; this is in preparation for IB*2.0*447 (TCR15) which will be updating some entries in that file.
+2 ;DBIA#10141
if $$INSTALDT^XPDUTL("IB*2.0*432")>1
QUIT
+3 NEW DATA,IEN,ERR,LN
+4 FOR LN=2:1:12
Begin DoDot:1
+5 SET DATA=$PIECE($TEXT(NM3551+LN),";;",2)
if DATA=""
QUIT
+6 SET IEN=$ORDER(^IBE(355.1,"B",$PIECE(DATA,U,2),""))
+7 if IEN=""
SET ERR(LN)=" "_$PIECE(DATA,U,2)
End DoDot:1
+8 if $DATA(ERR)
DO BULL(.ERR)
+9 QUIT
+10 ;
BULL(ERR) ; send mail bulletin if there was a problem with file 355.1
+1 ;
+2 NEW DIFROM,XMDUZ,XMTEXT,XMY,XMSUB,L,SITE,IBTXT,I
+3 SET SITE=$PIECE($$SITE^VASITE,U,2)
+4 SET XMSUB="Problem w/ TYPE OF PLAN (file #355.1) at "_SITE
+5 SET XMDUZ=.5
SET XMTEXT="IBTXT("
+6 KILL XMY
SET XMY("GRACE.FIAMENGO@DOMAIN.EXT")=""
+7 SET IBTXT(1)="During the pre-install check for IB*2.0*447 there was a problem with one or"
+8 SET IBTXT(2)="more names in the TYPE OF PLAN file (#355.1) at: "_SITE
+9 SET IBTXT(3)=""
+10 SET IBTXT(4)="The Name Check in IBY432PO did not find an exact match for the following: "
+11 SET L=5
FOR I=2:1:12
IF $DATA(ERR(I))
SET L=L+1
SET IBTXT(L)=ERR(I)
+12 DO ^XMD
+13 QUIT
+14 ;
NM3551 ; entries in file 355.1 to be checked
+1 ;
+2 ;;^CARVE-OUT^
+3 ;;^COMPREHENSIVE MAJOR MEDICAL^
+4 ;;^MEDICAL EXPENSE (OPT/PROF)^
+5 ;;^MEDICARE SECONDARY^
+6 ;;^MEDIGAP (SUPPLEMENTAL)^
+7 ;;^MEDIGAP (SUPPL - COINS, DED, PART B EXC)^
+8 ;;^MENTAL HEALTH^
+9 ;;^POINT OF SERVICE^
+10 ;;^PREFERRED PROVIDER ORGANIZATION (PPO)^
+11 ;;^RETIREE^
+12 ;;^SURGICAL EXPENSE INSURANCE^
+13 ;
+14 QUIT
+15 ;
KILLPEB ; Designed to remove the "Print EOB" option from the "IBCE 837 EDI REPORTS" menu.
+1 NEW MENUIEN,ITEMIEN,DIK,DA
+2 SET MENUIEN=$ORDER(^DIC(19,"B","IBCE 837 EDI REPORTS",0))
if MENUIEN=""
QUIT
+3 SET ITEMIEN=$ORDER(^DIC(19,MENUIEN,10,"C","PEB",0))
if ITEMIEN=""
QUIT
+4 SET DIK="^DIC(19,"_MENUIEN_",10,"
+5 SET DA=ITEMIEN
SET DA(1)=MENUIEN
+6 DO ^DIK
+7 QUIT
