Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY232PO

IBY232PO.m

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