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

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1IBY155PO ;ALB/DSM - IB*2*155 POST INIT ROUTINE ;25-MAR-2003
2 ;;2.0;INTEGRATED BILLING;**155**; 21-MAR-94
3 ;
4POST ; Set up check points for post-init
5 S %=$$NEWCP^XPDUTL("ADDUSR","ADDUSR^IBY155PO")
6 ;
7 ; default a No in the automatic MRA process parameter if undefined
8 I $P($G(^IBE(350.9,1,8)),U,11)="" D
9 . NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
10 . S DIE=350.9,DA=1,DR="8.11////0" D ^DIE
11 . Q
12 ;
13 ; default a Yes in the allow MRA processing parameter if undefined
14 I $P($G(^IBE(350.9,1,8)),U,12)="" D
15 . NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
16 . S DIE=350.9,DA=1,DR="8.12////1" D ^DIE
17 . Q
18 ;
19 ; Add new Claims Tracking non-billable reasons (File 356.8)
20 D
21 . NEW DA,DIC,DO,X,Y
22 . F X="MRA REC'D. NO SEC RESP EXISTS","MRA REC'D. SEC NOT BILLED" D
23 .. I $D(^IBE(356.8,"B",X)) Q ; already on file
24 .. S DIC="^IBE(356.8,",DIC(0)="F"
25 .. D FILE^DICN
26 .. Q
27 . Q
28 ;
29 ; Add a new Bill Form Type for MRA reports
30 D BFT^IBY155PR
31 ;
32 ; Modify the Medicare entries in the IB PROVIDER ID # TYPE file (355.97)
33 D
34 . NEW P,NAME,CODE,DA,DIE,DR
35 . F P="A","B" D
36 .. S NAME="MEDICARE PART "_P
37 .. I P="A" S CODE=670899
38 .. I P="B" S CODE="VA0"_+$$SITE^VASITE()
39 .. S DA=$O(^IBE(355.97,"B",NAME,"")) Q:'DA
40 .. S DIE=355.97,DR=".03///1C;.04///"_CODE
41 .. D ^DIE
42 .. Q
43 . Q
44 ;
45 ; Update Short Description field for IEN #964 in File 364.6
46 N IBDESC,DA,DIE,DR
47 D BMES^XPDUTL("Updating Short Description field for IEN #964 in the IB FORM SKELETON DEFINITION FILE")
48 S IBDESC="COB COVERED DAYS"
49 S DA=964,DIE="^IBA(364.6,",DR=".1///^S X=IBDESC" D ^DIE
50 D COMPLETE
51 ;
52 ; Delete 3 action protocols from the CSA screen menu protocol
53 D BMES^XPDUTL("Removing actions from the CSA screen")
54 D CSA
55 D COMPLETE
56 ;
57 ; Build the new "AMRA" index for file 361.1
58 D BMES^XPDUTL("A new index will now be created for file 361.1.")
59 D AMRA,COMPLETE
60 ;
61 ; Delete old remark codes fields
62 D BMES^XPDUTL("Deleting old line item remarks code fields from EOB file 361.1")
63 S DIK="^DD(361.115,",DA(1)=361.115,DA=3.01 D ^DIK
64 S DIK="^DD(361.115,",DA(1)=361.115,DA=3.02 D ^DIK
65 D COMPLETE
66 ;
67 ; Check the insurance company file for fake Medicare WNR entries
68 D BMES^XPDUTL("Scanning Insurance Company File for Medicare WNR Entries ...")
69 D INSCHK^IBCEMU3,COMPLETE
70 ;
71 ;
72 Q ; IBY155PO
73 ;
74 ;
75 ;
76 ;
77ADDUSR ; Add the Bill Authorizer for acceptable MRA secondary claims
78 ; to the New Person file (#200)
79 ;
80 N DIC,X,Y,DO,DD,DLAYGO
81 S DIC(0)="",DIC="^VA(200,",X="AUTHORIZER,IB MRA" D ^DIC
82 I Y>0 D Q
83 . D BMES^XPDUTL("User, AUTHORIZER,IB MRA, already exists in the NEW PERSON file - not added")
84 . D COMPLETE
85 D BMES^XPDUTL("Adding new user, AUTHORIZER,IB MRA, to the NEW PERSON file")
86 S DLAYGO=200,DIC(0)="L",DIC="^VA(200,",DIC("DR")="1////MRA",X="AUTHORIZER,IB MRA" D FILE^DICN K DIC,DO,DD,DLAYGO
87 I Y'>0 D
88 . D BMES^XPDUTL("A problem was encountered trying to add user, AUTHORIZER,IB MRA")
89 . D BMES^XPDUTL("The entry must be added manually to the NEW PERSON file")
90 E D
91 .D BMES^XPDUTL("User, AUTHORIZER,IB MRA, was successfully added to the NEW PERSON file")
92 D COMPLETE
93 Q
94 ;
95INCLUDE(Y) ; Code executed by build to determine which entries from file 364.7 should be included
96 NEW IBOUT,LINE S IBOUT=0
97 F LINE=2:1:5 I $P($T(ENT7+LINE),";;",2)[(U_+Y_U) S IBOUT=1 Q
98INCX ;
99 Q IBOUT
100 ;
101ENT7 ; changed and new entries for file 364.7 to be included in build
102 ;
103 ;;^115^176^181^182^188^268^270^275^293^296^297^305^306^308^309^310^322^344^346^353^493^503^504^
104 ;;^623^630^631^633^635^717^728^729^736^809^814^815^816^822^823^824^832^839^842^846^851^
105 ;;^852^853^854^855^856^857^858^859^860^861^862^864^865^870^871^872^875^876^882^883^886^890^947^951^956^957^
106 ;;^958^959^960^961^962^963^964^965^966^967^975^978^980^982^983^985^1013^1014^
107 Q
108ENT6 ; new entry for file 364.6
109 ;;^716^964^
110 Q
111 ;
112CSA ; Remove 3 actions from the CSA screen menu protocol
113 NEW AP,MPI,DA,DIK,API,APNM
114 S AP("IBCEM CSA EDIT BILL")=""
115 S AP("IBCEM CSA COB MANAGEMENT")=""
116 S AP("IBCEM CSA VIEW EOB")=""
117 S MPI=$O(^ORD(101,"B","IBCEM CSA MSG MENU","")) ; menu protocol ien
118 I 'MPI G CSAX
119 S DA(1)=MPI
120 S DIK="^ORD(101,"_MPI_",10,"
121 S DA=0 F S DA=$O(^ORD(101,MPI,10,DA)) Q:'DA D
122 . S API=+$G(^ORD(101,MPI,10,DA,0))
123 . S APNM=$P($G(^ORD(101,API,0)),U,1)
124 . I APNM="" Q
125 . I '$D(AP(APNM)) Q
126 . D ^DIK
127 . Q
128CSAX ;
129 Q
130 ;
131AMRA ; Build the new index
132 N MRAXR,MRARES,MRAOUT
133 S MRAXR("FILE")=361.1
134 S MRAXR("NAME")="AMRA"
135 S MRAXR("TYPE")="R"
136 S MRAXR("USE")="S"
137 S MRAXR("EXECUTION")="R"
138 S MRAXR("ACTIVITY")="IR"
139 S MRAXR("SHORT DESCR")="Index by EOB type and Review Status"
140 S MRAXR("VAL",1)=.04
141 S MRAXR("VAL",1,"SUBSCRIPT")=1
142 S MRAXR("VAL",1,"COLLATION")="F"
143 S MRAXR("VAL",2)=.16
144 S MRAXR("VAL",2,"SUBSCRIPT")=2
145 S MRAXR("VAL",2,"COLLATION")="F"
146 D CREIXN^DDMOD(.MRAXR,"SW",.MRARES,"MRAOUT")
147 I +$G(MRARES) D MES^XPDUTL("Index successfully created!") G AMRAX
148 ;
149 ; Index file failure. Not created for some reason
150 ;
151 D MES^XPDUTL("A PROBLEM WAS ENCOUNTERED. INDEX FILE NOT CREATED!!!")
152 D MES^XPDUTL("SENDING MAILMAN MESSAGE...")
153 D MES^XPDUTL("PLACING THE MRA MANAGEMENT SCREEN OUT-OF-ORDER.")
154 NEW XMDUZ,XMSUBJ,XMBODY,MSG,XMTO,DA,DIE,DR
155 S XMDUZ=DUZ,XMSUBJ="IB*2*155 Error: AMRA index not built",XMBODY="MSG"
156 S MSG(1)="The new ""AMRA"" index for file 361.1 was not created at"
157 S MSG(2)=" "
158 S MSG(3)=" "_$$SITE^VASITE
159 S MSG(4)=" "
160 S MSG(5)="The MRA management worklist has been placed out of order."
161 ;
162 ; recipients of message
163 S XMTO(DUZ)=""
164 S XMTO("eric.gustafson@daou.com")=""
165 S XMTO("michael.f.pida@us.pwc.com")=""
166 S XMTO("Janet.Harris2@med.va.gov")=""
167 S XMTO("Loretta.Gulley2@med.va.gov")=""
168 S XMTO("G.PATCHES")=""
169 S XMTO("G.IB EDI")=""
170 S XMTO("G.IB EDI SUPERVISOR")=""
171 ;
172 D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
173 ;
174 ; place MRA management worklist screen out of order
175 S DA=$O(^DIC(19,"B","IBCE MRA MANAGEMENT",""))
176 I DA S DIE=19,DR="2////IB Patch 155 Installation Failure" D ^DIE
177 ;
178AMRAX ;
179 Q
180 ;
181COMPLETE ;
182 D BMES^XPDUTL("Step complete.")
183 Q
184 ;
Note: See TracBrowser for help on using the repository browser.