source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBY232PO.m@ 1111

Last change on this file since 1111 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 7.0 KB
RevLine 
[613]1IBY232PO ;ALB/BSL - IB*2*232 POST-INSTALL ;25-AUG-03
2 ;;2.0;INTEGRATED BILLING;**232**;21-MAR-94
3 ;
4 N DIC,DIK,DA,Y,X
5 D BMES^XPDUTL("Post-Installation Updates")
6 ;
7IBSITE ;CHANGE LIVE AND TEST QUEUE IN IB SITE PARAMETERS FILE
8 S $P(^IBE(350.9,1,8),"^",1)="MCH" ;LIVE QUEUE
9 ;S $P(^IBE(350.9,1,8),"^",1)="G.MCH@ISC-ALBANY.MED.VA.GOV" ;LIVE QUEUE
10 S $P(^IBE(350.9,1,8),"^",9)="G.MCH@ISC-ALBANY.MED.VA.GOV" ;TEST QUEUE
11 ;SAVE 8 NODE OF IB SITE PARAMETERS
12 ;S ^XTMP("P232","NEW",INC,"350.9",8)=^IBE(350.9,1,8)
13 ;
14 ;S ^XTMP("P232","NEW",0)=(INC+1)
15 ;
16MAIL ;REMOTE MEMBER IN MAIL GROUP IS SAME AS IN MCR
17 N IBMCR,IBMCH,DLAYGO,DIC,DIK,DA,D0,DD,Z,Z0 ; IA 4439
18 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
19 . I '$D(^XMB(3.8,IBMCH,6,"B",Z0)) D
20 .. 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
21 .. I Y>0 S DA(1)=IBMCR,DA=Z,DIK="^XMB(3.8,"_DA(1)_",6," D ^DIK
22 ;
23 D BMES^XPDUTL("Updating facility provider ids for all insurance companies")
24 N DO,DD,DLAYGO,DIC,X,Y,Z,Z0,Z00,Z11,Z17,IBINS,IBID,IBHCFA,IBUB
25 S IBID=$$BF^IBCU()
26 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
27 . S (IBHCFA,IBUB)=0
28 . 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
29 .. I $P(Z00,U,6)=IBID S:$P(Z00,U,4)=2 IBHCFA=1 S:$P(Z00,U,4)=1 IBUB=1 Q
30 . 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
31 . 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
32 ;
33 D BMES^XPDUTL("Deleting unneeded cross refs in file 399")
34 D DELIX^DDMOD(399,101,4),DELIX^DDMOD(399,102,5),DELIX^DDMOD(399,103,4)
35 I $D(^IBE(355.97,10,0)) S DA=10,DIK="^IBE(355.97," D ^DIK
36 I $$PROD^IBCORC,DT<3050101 D ; Production?
37 . N DIFROM,XMTO,XMBODY,XMSUBJ,XMZ,XMDUZ,DUZ,IBSITE,IBBODY
38 . D BMES^XPDUTL("SENDING EDI ENHANCEMENTS CONFIRMATION TO AUSTIN")
39 . S IBSITE=$$SITE^VASITE()
40 . S DUZ(0)="@",DUZ=.5,XMDUZ=DUZ,XMBODY="IBBODY"
41 . S XMSUBJ="EDI ENHANCEMENTS LOADED AT STATION #: "_$P(IBSITE,U,3)_$S($G(^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",1)):" (AGAIN)",1:"")
42 . S XMTO("G.ZZ_EDIENHANCE@FO-ALBANY.MED.VA.GOV")=""
43 . S IBBODY(1)="EDI ENHANCEMENTS HAS BEEN LOADED INTO THE LIVE ACCOUNT OF",IBBODY(2)=$P(IBSITE,U,2)
44 . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
45 . I $G(XMZ) S ^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",0)="3050101^"_DT_"^EDI ENHANCEMENTS CONFIRMATION ACKNOWLEDGED",^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",1)=XMZ
46 . ;
47 . I '$G(^XTMP("IB_EDI_ENHANCEMENTS_CONFIRMED",1)) D
48 .. N DIFROM,IBBODY,XMBODY,XMDUZ,XMSUBJ,XMTO,DUZ
49 .. S DUZ=.5,DUZ(0)="@",XMDUZ=DUZ
50 .. S XMBODY="IBBODY"
51 .. D BMES^XPDUTL("NO CONFIRMATION WAS SENT FOR INSTALL - CONTACT EVS!!!")
52 .. S XMSUBJ="CALL NATIONAL HELP DESK - NO EDI ENHANCEMENTS CONFIRMATION"
53 .. S XMTO("G.IB EDI SUPERVISOR")=""
54 .. S IBBODY(1)="*** IMPORTANT **** IMPORTANT **** IMPORTANT **** IMPORTANT **** IMPORTANT ***",IBBODY(2)=" "
55 .. 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."
56 .. D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
57 ;
58 D END
59 Q
60 ;
61 ;
62PEND232 ; CLEANS OUT THE ENTRIES IN THE PENDING LIST THAT
63 ; THE PROCESS OF PARRALLEL TESTING HAS NOT ALLOWED TO RECEIVE REPORTS BACK
64 ;
65 ; THIS IS A TWO PART PROCESS, THE FIRST PART IDENTIFIES THE
66 ; PENDING ENTRIES IN THE PENDING REPORT
67 ; IF THERE ARE VALID ENTRIES IN THIS REPORT THEY SHOULD BE
68 ; REMOVED FROM THE ^BTMP GLOBAL BEFORE PERFORMING THE SECOND
69 ; STEP WHICH IS TO KILL ALL THE ENTRIES STILL LISTED IN ^BTMP
70 ;
71 ;FIND ALL THE ENTRIES IN THE ^IBA(364.1,"ASTAT","P"
72 S X=""
73 K ^BTMP(364.1)
74 F S X=$O(^IBA(364.1,"ASTAT","P",X)) Q:X="" D
75 . ; STORE IN TEMP GLOBAL ^BTMP
76 . ;SET BTMP TO WHAT CURRENT STATUS VALUE IS
77 . S ^BTMP(364.1,X)=$P($G(^IBA(364.1,X,0)),"^",2)
78 . ; SET CURRENT STATUS TO A0
79 . I $D(^BTMP(364.1,X)) S $P(^IBA(364.1,X,0),"^",2)="A0"
80 W !,"^BTMP GLOBAL IS PREPARED WITH PENDING ENTRIES!"
81 Q
82 ;
83KILLPEND ; KILL STAT ENTRY
84 S X=""
85 F S X=$O(^BTMP(364.1,X)) Q:X="" D
86 . K ^IBA(364.1,"ASTAT","P",X)
87 W !,"ALL GONE!"
88 Q
89 ;
90END ;
91 D BMES^XPDUTL("Step complete")
92 ;
93 D BMES^XPDUTL("Pre-install complete")
94 Q
95 ;
96DELLOC ; Local form for 837 transmission - delete all local override fields
97 ; for changed form 8 fields
98 N IB7,IB6,IB60,IB7X,IB7X0,Q,DA,DIK
99 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
100 . Q:'$$INCLUDE^IBY232PR(6,+$P(IB60,U,3)) ; field is being changed
101 . N MES
102 . 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)
103 . S IB7X=0 F S IB7X=$O(^IBA(364.7,"B",IB6,IB7X)) Q:'IB7X D
104 . . S IB7X0=$G(^IBA(364.7,IB7X,0)) Q:IB7X0=""
105 . . 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")
106 . . S MES=MES+1,MES(MES)=" Insurance co : "_$S($P(IB7X0,U,5):$$EXTERNAL^DILFD(364.7,.05,"",+$P(IB7X0,U,5)),1:"ALL")
107 . . S MES=MES+1,MES(MES)=" Bill Type : "_$S($P(IB7X0,U,6)="I":"INPATIENT",$P(IB7X0,U,6)="P":"PROFESSIONAL",1:"BOTH")
108 . . Q:$G(^IBA(364.7,IB7X,1))=""
109 . . S MES=MES+1,MES(MES)=" Override format code/description: "
110 . . S MES=MES+1,MES(MES)=^IBA(364.7,IB7X,1)
111 . . 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))
112 . . S MES=MES+1,MES(MES)=" "
113 . . D MES^XPDUTL(.MES)
114 . . S DA=IB7X,DIK="^IBA(364.7," D ^DIK ; Delete entries in 364.7 for override flds
115 . S DIK="^IBA(364.6,",DA=IB6 D ^DIK ; delete entry in 364.6 for o/ride flds
116 Q
117 ;
118PRECOPY ;K ^XTMP("P232")
119 ;I $G(^XTMP("P232",0))="" S ^XTMP("P232",0)="3040601^3030830^PATCH IB*2.0*232 SWITCH OPTION"
120 ;I $G(^XTMP("P232","OLD",0))="" S ^XTMP("P232","OLD",0)=1
121 ;
122 ; CREATE INCR BACKUPS FOR RESTORE OF PREV
123 ;N INC,N S INC=^XTMP("P232","OLD",0)
124 ;F N=5:1:7 M ^XTMP("P232","OLD",INC,"364."_N)=^IBA("364."_N)
125 ;
126 ;SAVE DDs REFERENCING NEW CODE
127 ;M ^XTMP("P232","OLD",INC,"355.9")=^DD(355.9)
128 ;M ^XTMP("P232","OLD",INC,"355.91")=^DD(355.91)
129 ;M ^XTMP("P232","OLD",INC,"355.92")=^DD(355.92)
130 ;M ^XTMP("P232","OLD",INC,"355.93")=^DD(355.93)
131 ;M ^XTMP("P232","OLD",INC,"355.97")=^DD(355.97)
132 ;M ^XTMP("P232","OLD",INC,"399")=^DD(399)
133 ;M ^XTMP("P232","OLD",INC,"399.0222")=^DD(399.0222)
134 ;M ^XTMP("P232","OLD",INC,"36")=^DD(36)
135 ;M ^XTMP("P232","OLD",INC,"2")=^DD(2)
136 ;M ^XTMP("P232","OLD",INC,"DIC","36")=^DIC(36)
137 ;
138 ;SAVE 8-NODE OF 350.9
139 ;S ^XTMP("P232","OLD",INC,"350.9",1,8)=^IBE(350.9,1,8)
140 ;
141 ;SAVE OLD INPUT TEMPS
142 ;N TMPL
143 ;S TMPL="" S TMPL=$O(^DIE("B","IB SCREEN82",TMPL))
144 ;M ^XTMP("P232","OLD",INC,"DIE",TMPL)=^DIE(TMPL)
145 ;S TMPL="" S TMPL=$O(^DIE("B","IB SCREEN8H",TMPL))
146 ;M ^XTMP("P232","OLD",INC,"DIE",TMPL)=^DIE(TMPL)
147 ;S ^XTMP("P232","OLD",0)=(INC+1)
Note: See TracBrowser for help on using the repository browser.