IBY232PO ;ALB/BSL - IB*2*232 POST-INSTALL ;25-AUG-03
 ;;2.0;INTEGRATED BILLING;**232**;21-MAR-94
 ;
 N DIC,DIK,DA,Y,X
 D BMES^XPDUTL("Post-Installation Updates")
 ;
IBSITE ;CHANGE LIVE AND TEST QUEUE IN IB SITE PARAMETERS FILE
 S $P(^IBE(350.9,1,8),"^",1)="MCH"  ;LIVE QUEUE
 ;S $P(^IBE(350.9,1,8),"^",1)="G.MCH@ISC-ALBANY.MED.VA.GOV"  ;LIVE QUEUE
 S $P(^IBE(350.9,1,8),"^",9)="G.MCH@ISC-ALBANY.MED.VA.GOV"  ;TEST QUEUE
 ;SAVE 8 NODE OF IB SITE PARAMETERS
 ;S ^XTMP("P232","NEW",INC,"350.9",8)=^IBE(350.9,1,8)
 ;
 ;S ^XTMP("P232","NEW",0)=(INC+1)
 ;
MAIL ;REMOTE MEMBER IN MAIL GROUP IS SAME AS IN MCR
 N IBMCR,IBMCH,DLAYGO,DIC,DIK,DA,D0,DD,Z,Z0 ; IA 4439
 S IBMCR=+$O(^XMB(3.8,"B","MCR",0)),IBMCH=+$O(^XMB(3.8,"B","MCH",0)) S Z=0 F  S Z=$O(^XMB(3.8,IBMCR,6,Z)) Q:'Z  S Z0=$P($G(^XMB(3.8,IBMCR,6,Z,0)),U) I Z0'="" D
 . I '$D(^XMB(3.8,IBMCH,6,"B",Z0)) D
 .. S DLAYGO=3.812,DIC(0)="L",X=Z0,DA(1)=IBMCH,DIC="^XMB(3.8,"_DA(1)_",6," D FILE^DICN K DO,DD,DA,DLAYGO,DIC
 .. I Y>0 S DA(1)=IBMCR,DA=Z,DIK="^XMB(3.8,"_DA(1)_",6," D ^DIK
 ;
 D BMES^XPDUTL("Updating facility provider ids for all insurance companies")
 N DO,DD,DLAYGO,DIC,X,Y,Z,Z0,Z00,Z11,Z17,IBINS,IBID,IBHCFA,IBUB
 S IBID=$$BF^IBCU()
 I IBID S IBINS=0 F  S IBINS=$O(^DIC(36,IBINS)) Q:'IBINS  S Z11=$P($G(^(IBINS,0)),U,11),Z17=$P($G(^(0)),U,17) D
 . S (IBHCFA,IBUB)=0
 . S Z0=0 F  S Z0=$O(^IBA(355.92,"B",IBINS,Z0)) Q:'Z0  S Z00=$G(^IBA(355.92,Z0,0)) D  Q:IBHCFA&IBUB
 .. I $P(Z00,U,6)=IBID S:$P(Z00,U,4)=2 IBHCFA=1 S:$P(Z00,U,4)=1 IBUB=1 Q
 . I Z11'="",'IBUB S X=IBINS,DIC("DR")=".04////1;.06////"_IBID_";.07////"_Z11,DIC="^IBA(355.92,",DLAYGO=355.92,DIC(0)="L" D FILE^DICN K DO,DD,DLAYGO,DIC
 . I Z17'="",'IBHCFA S X=IBINS,DIC("DR")=".04////2;.06////"_IBID_";.07////"_Z17,DIC="^IBA(355.92,",DLAYGO=355.92,DIC(0)="L" D FILE^DICN K DO,DD,DLAYGO,DIC
 ;
 D BMES^XPDUTL("Deleting unneeded cross refs in file 399")
 D DELIX^DDMOD(399,101,4),DELIX^DDMOD(399,102,5),DELIX^DDMOD(399,103,4)
 I $D(^IBE(355.97,10,0)) S DA=10,DIK="^IBE(355.97," D ^DIK
 I $$PROD^IBCORC,DT<3050101 D  ; Production?
 . N DIFROM,XMTO,XMBODY,XMSUBJ,XMZ,XMDUZ,DUZ,IBSITE,IBBODY
 . D BMES^XPDUTL("SENDING EDI ENHANCEMENTS CONFIRMATION TO AUSTIN")
 . S IBSITE=$$SITE^VASITE()
 . S DUZ(0)="@",DUZ=.5,XMDUZ=DUZ,XMBODY="IBBODY"
 . S XMSUBJ="EDI ENHANCEMENTS LOADED AT STATION #: "_$P(IBSITE,U,3)_$S($G(^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",1)):" (AGAIN)",1:"")
 . S XMTO("G.ZZ_EDIENHANCE@FO-ALBANY.MED.VA.GOV")=""
 . S IBBODY(1)="EDI ENHANCEMENTS HAS BEEN LOADED INTO THE LIVE ACCOUNT OF",IBBODY(2)=$P(IBSITE,U,2)
 . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
 . I $G(XMZ) S ^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",0)="3050101^"_DT_"^EDI ENHANCEMENTS CONFIRMATION ACKNOWLEDGED",^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",1)=XMZ
 . ;
 . I '$G(^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",1)) D
 .. N DIFROM,IBBODY,XMBODY,XMDUZ,XMSUBJ,XMTO,DUZ
 .. S DUZ=.5,DUZ(0)="@",XMDUZ=DUZ
 .. S XMBODY="IBBODY"
 .. D BMES^XPDUTL("NO CONFIRMATION WAS SENT FOR INSTALL - CONTACT EVS!!!")
 .. S XMSUBJ="CALL NATIONAL HELP DESK - NO EDI ENHANCEMENTS CONFIRMATION"
 .. S XMTO("G.IB EDI SUPERVISOR")=""
 .. S IBBODY(1)="*** IMPORTANT **** IMPORTANT **** IMPORTANT **** IMPORTANT **** IMPORTANT ***",IBBODY(2)=" "
 .. S IBBODY(3)="Contact the National Help desk (EVS) IMMEDIATELY to report no confirmation",IBBODY(4)="was sent from your site for EDI Enhancements after patch IB*2*232 install."
 .. D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
 ;
 D END
 Q
 ;
 ;
PEND232 ; CLEANS OUT THE ENTRIES IN THE PENDING LIST THAT
 ; THE PROCESS OF PARRALLEL TESTING HAS NOT ALLOWED TO RECEIVE REPORTS BACK
 ;
 ; THIS IS A TWO PART PROCESS, THE FIRST PART IDENTIFIES THE
 ; PENDING ENTRIES IN THE PENDING REPORT
 ; IF THERE ARE VALID ENTRIES IN THIS REPORT THEY SHOULD BE
 ; REMOVED FROM THE ^BTMP GLOBAL BEFORE PERFORMING THE SECOND
 ; STEP WHICH IS TO KILL ALL THE ENTRIES STILL LISTED IN ^BTMP
 ;
 ;FIND ALL THE ENTRIES IN THE ^IBA(364.1,"ASTAT","P"
 S X=""
 K ^BTMP(364.1)
 F  S X=$O(^IBA(364.1,"ASTAT","P",X)) Q:X=""  D
 . ; STORE IN TEMP GLOBAL ^BTMP
 . ;SET BTMP TO WHAT CURRENT STATUS VALUE IS
 . S ^BTMP(364.1,X)=$P($G(^IBA(364.1,X,0)),"^",2)
 . ; SET CURRENT STATUS TO A0
 . I $D(^BTMP(364.1,X)) S $P(^IBA(364.1,X,0),"^",2)="A0"
 W !,"^BTMP GLOBAL IS PREPARED WITH PENDING ENTRIES!"
 Q
 ;
KILLPEND ; KILL STAT ENTRY
 S X=""
 F  S X=$O(^BTMP(364.1,X)) Q:X=""  D
 . K ^IBA(364.1,"ASTAT","P",X)
 W !,"ALL GONE!"
 Q
 ;
END ;
 D BMES^XPDUTL("Step complete")
 ;
 D BMES^XPDUTL("Pre-install complete")
 Q
 ;
DELLOC ; Local form for 837 transmission - delete all local override fields
 ; for changed form 8 fields
 N IB7,IB6,IB60,IB7X,IB7X0,Q,DA,DIK
 S IB7=9999 F  S IB7=$O(^IBA(364.7,IB7)) Q:'IB7  S IB6=+$G(^(IB7,0)),IB60=$G(^IBA(364.6,IB6,0)) I $P($G(^IBE(353,+IB60,2)),U,2)="T"  D  ; We have a transmit form o/ride
 . Q:'$$INCLUDE^IBY232PR(6,+$P(IB60,U,3))  ; field is being changed
 . N MES
 . S MES=1,MES(1)="Removing local field from 364.6 #"_IB6_" "_$P(IB60,U,10)_"  "_$P($G(^IBA(364.6,+$P(IB60,U,3),0)),U,10)
 . S IB7X=0 F  S IB7X=$O(^IBA(364.7,"B",IB6,IB7X)) Q:'IB7X  D
 . . S IB7X0=$G(^IBA(364.7,IB7X,0)) Q:IB7X0=""
 . . S MES=MES+1,MES(MES)="  Override data element: "_$S(+$P(IB7X0,U,3):$$EXTERNAL^DILFD(364.7,.03,"",+$P(IB7X0,U,3)),1:"NONE DEFINED")
 . . S MES=MES+1,MES(MES)="  Insurance co         : "_$S($P(IB7X0,U,5):$$EXTERNAL^DILFD(364.7,.05,"",+$P(IB7X0,U,5)),1:"ALL")
 . . S MES=MES+1,MES(MES)="  Bill Type            : "_$S($P(IB7X0,U,6)="I":"INPATIENT",$P(IB7X0,U,6)="P":"PROFESSIONAL",1:"BOTH")
 . . Q:$G(^IBA(364.7,IB7X,1))=""
 . . S MES=MES+1,MES(MES)="  Override format code/description: "
 . . S MES=MES+1,MES(MES)=^IBA(364.7,IB7X,1)
 . . S Q=0 F  S Q=$O(^IBA(364.7,IB7X,3,Q)) Q:'Q  S MES=MES+1,MES(MES)=$G(^IBA(364.7,IB7X,3,Q,0))
 . . S MES=MES+1,MES(MES)=" "
 . . D MES^XPDUTL(.MES)
 . . S DA=IB7X,DIK="^IBA(364.7," D ^DIK ; Delete entries in 364.7 for override flds
 . S DIK="^IBA(364.6,",DA=IB6 D ^DIK ; delete entry in 364.6 for o/ride flds
 Q
 ;
PRECOPY ;K ^XTMP("P232")
 ;I $G(^XTMP("P232",0))="" S ^XTMP("P232",0)="3040601^3030830^PATCH IB*2.0*232 SWITCH OPTION"
 ;I $G(^XTMP("P232","OLD",0))="" S ^XTMP("P232","OLD",0)=1
 ;
 ; CREATE INCR BACKUPS FOR RESTORE OF PREV
 ;N INC,N S INC=^XTMP("P232","OLD",0)
 ;F N=5:1:7  M ^XTMP("P232","OLD",INC,"364."_N)=^IBA("364."_N)
 ;
 ;SAVE DDs REFERENCING NEW CODE
 ;M ^XTMP("P232","OLD",INC,"355.9")=^DD(355.9)
 ;M ^XTMP("P232","OLD",INC,"355.91")=^DD(355.91)
 ;M ^XTMP("P232","OLD",INC,"355.92")=^DD(355.92)
 ;M ^XTMP("P232","OLD",INC,"355.93")=^DD(355.93)
 ;M ^XTMP("P232","OLD",INC,"355.97")=^DD(355.97)
 ;M ^XTMP("P232","OLD",INC,"399")=^DD(399)
 ;M ^XTMP("P232","OLD",INC,"399.0222")=^DD(399.0222)
 ;M ^XTMP("P232","OLD",INC,"36")=^DD(36)
 ;M ^XTMP("P232","OLD",INC,"2")=^DD(2)
 ;M ^XTMP("P232","OLD",INC,"DIC","36")=^DIC(36)
 ;
 ;SAVE 8-NODE OF 350.9
 ;S ^XTMP("P232","OLD",INC,"350.9",1,8)=^IBE(350.9,1,8)
 ;
 ;SAVE OLD INPUT TEMPS
 ;N TMPL
 ;S TMPL="" S TMPL=$O(^DIE("B","IB SCREEN82",TMPL))
 ;M ^XTMP("P232","OLD",INC,"DIE",TMPL)=^DIE(TMPL)
 ;S TMPL="" S TMPL=$O(^DIE("B","IB SCREEN8H",TMPL))
 ;M ^XTMP("P232","OLD",INC,"DIE",TMPL)=^DIE(TMPL)
 ;S ^XTMP("P232","OLD",0)=(INC+1)