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

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

initial load of WorldVistAEHR
File size: 7.0 KB
Line 
1IBY377PR ;ALB/ESG - Pre-Installation for IB patch 377 ;26-Nov-2007
2 ;;2.0;INTEGRATED BILLING;**377**;21-MAR-94;Build 23
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 D DELOF ; delete all output formatter data elements included in build
6 D DELINS ; delete inactive patient insurance fields and data
7 D DELIX^DDMOD(364.6,.1,1) ; delete traditional x-ref
8 ;
9 Q
10 ;
11 ;
12DELOF ; Delete included output formatter entries
13 NEW FILE,DIK,LN,TAG,DATA,PCE,DA,Y
14 F FILE=5,6,7 S DIK="^IBA(364."_FILE_"," F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" D
15 . F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA("364."_FILE,DA,0)) D ^DIK
16 . Q
17 ;
18 ; Also delete output formatter entries which are not going to be
19 ; re-added later. These are non-functioning or obsolete entries
20 ; in file 364.6.
21 S DIK="^IBA(364.6,",TAG="DEL6+2",DATA=$P($T(@TAG),";;",2)
22 I DATA'="" D
23 . F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA(364.6,DA,0)) D ^DIK
24 . Q
25 ;
26 ; Also delete output formatter entries which are not going to be
27 ; re-added later. These are non-functioning or obsolete entries
28 ; in file 364.7.
29 S DIK="^IBA(364.7,",TAG="DEL7+2",DATA=$P($T(@TAG),";;",2)
30 I DATA'="" D
31 . F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA I $D(^IBA(364.7,DA,0)) D ^DIK
32 . Q
33 ;
34DELOFX ;
35 Q
36 ;
37DELINS ; This procedure will delete 7 inactive fields from the patient insurance subfile (#2.312)
38 ; The reason we are doing this is so we can increase the size of the subscriber name field from 30 to 50 chars
39 ; and we need to make some room.
40 ; Fields deleted: 7 *RENEWAL DATE
41 ; 9 *AGENT'S NAME
42 ; 10 *AGENT'S TELEPHONE NUMBER
43 ; 11 *AGENT'S STREET
44 ; 12 *AGENT'S CITY
45 ; 13 *AGENT'S STATE
46 ; 14 *AGENT'S ZIP CODE
47 ; These fields have been inactivated since early 1993, being deleted in 2008.
48 ;
49 D BMES^XPDUTL("Removing inactive data from the patient insurance file ... ")
50 ;
51 NEW DFN,CNT,POL,PCE,DIK,DA
52 ;
53 ; If these fields are already gone, then this process has already been run so get out
54 I '$$VFIELD^DILFD(2.312,7),'$$VFIELD^DILFD(2.312,9),'$$VFIELD^DILFD(2.312,11) D MES^XPDUTL(" ... Data and Fields already removed. No further action.") G DELINSX
55 ;
56 D MES^XPDUTL("Each ""."" represents 10,000 patients ")
57 S DFN=0,CNT=0
58 F S DFN=$O(^DPT(DFN)) Q:'DFN D
59 . S CNT=CNT+1 I CNT#10000=0,'$D(ZTQUEUED) W "."
60 . S POL=0 F S POL=$O(^DPT(DFN,.312,POL)) Q:'POL D
61 .. Q:'$D(^DPT(DFN,.312,POL,0))
62 .. F PCE=7,9:1:14 S $P(^DPT(DFN,.312,POL,0),U,PCE)="" ; blank out these 7 pieces
63 .. Q
64 . Q
65 D MES^XPDUTL(" ... Done.")
66 ;
67 ; now remove the fields from the DD
68 D BMES^XPDUTL("Removing inactive fields from the Data Dictionary ... ")
69 S DIK="^DD(2.312,"
70 S DA(1)=2.312
71 F DA=7,9:1:14 D ^DIK
72 D MES^XPDUTL(" ... Done.")
73 ;
74DELINSX ;
75 Q
76 ;
77INCLUDE(FILE,Y) ; function to determine if output formatter entry should be
78 ; included in the build
79 ; FILE=5,6,7 indicating file 364.x
80 ; Y=ien to file
81 ;
82 NEW OK,LN,TAG,DATA
83 S OK=0
84 F LN=2:1 S TAG="ENT"_FILE_"+"_LN,DATA=$P($T(@TAG),";;",2) Q:DATA="" I $F(DATA,U_Y_U) S OK=1 Q
85INCLUDEX ;
86 Q OK
87 ;
88 ;-----------------------------------------------------------------------
89 ; 364.5 entries modified:
90 ;
91ENT5 ; output formatter entries in file 364.5 to be included
92 ;
93 ;;
94 ;
95 ;-----------------------------------------------------------------------
96 ; 364.6 entries modified:
97 ;
98ENT6 ; output formatter entries in file 364.6 to be included
99 ;
100 ;;^1^3^7^9^11^12^14^15^16^17^18^22^26^27^28^29^30^31^32^33^34^35^36^37^38^39^40^42^43^44^45^46^47^48^49^50^51^
101 ;;^52^53^54^55^56^57^58^59^60^61^62^63^64^65^66^67^70^71^72^73^74^75^76^81^82^83^84^85^86^87^88^89^91^92^93^95^
102 ;;^96^97^98^99^100^101^102^103^104^105^106^108^109^110^111^112^113^114^115^116^117^118^119^120^121^122^123^124^
103 ;;^125^126^127^128^129^130^131^132^133^134^135^136^137^138^165^166^167^168^169^170^171^172^173^174^175^177^178^
104 ;;^179^180^181^182^183^185^186^187^188^189^190^192^194^226^227^230^242^479^481^483^488^579^580^581^582^583^610^
105 ;;^775^783^784^785^789^790^793^794^795^796^805^808^809^810^811^812^813^814^815^817^818^819^820^821^822^823^825^
106 ;;^826^828^829^830^831^832^833^834^835^836^837^838^840^841^842^843^844^845^846^847^848^849^850^851^852^854^855^
107 ;;^856^857^858^859^860^861^862^863^864^866^867^868^869^870^871^872^873^874^875^876^877^879^880^881^882^883^891^
108 ;;^892^893^894^895^896^897^898^899^900^901^902^903^904^905^906^907^908^909^910^911^912^913^914^915^916^917^918^
109 ;;^919^920^921^923^924^936^937^938^939^941^942^943^944^945^946^947^948^949^950^952^956^957^960^961^962^964^965^
110 ;;^968^971^972^973^974^975^976^978^982^985^986^987^988^990^991^992^993^994^999^1002^1005^1006^1007^1009^1011^
111 ;;^1012^1015^1016^1018^1019^1020^1029^1030^1031^1032^1033^1034^1035^1036^1037^1038^1039^1040^1041^1042^1043^
112 ;;^1044^1045^1046^1047^1048^1051^1058^1059^1060^1061^1062^1063^1065^1072^1073^1074^1075^1076^1077^1081^1083^1084^
113 ;;^1085^1086^1087^1088^1089^1090^1091^1094^1095^1096^1097^1098^1099^1100^1101^1102^1103^1104^1107^1108^1110^
114 ;;^1111^1112^1113^1114^1115^1117^1118^1119^1120^1121^1122^1123^1124^1127^1128^1129^1130^1131^1132^1133^1134^
115 ;;^1136^1137^1138^1139^1140^1141^1142^1143^1154^1155^1156^1157^1158^1159^1160^1161^1163^1164^1165^1166^1167^
116 ;;^1168^1169^1170^1172^1173^1174^1175^1176^1177^1178^1179^1181^1182^1183^1184^1185^1186^1187^1188^1191^1192^
117 ;;^1194^1195^1196^1198^1199^1200^1201^1202^1203^1204^1205^1206^1209^1210^1211^1212^1213^1214^1215^1216^1217^
118 ;;^1224^1225^1226^1227^1228^1229^1230^1231^1232^1233^1234^1235^1236^1237^1238^1239^1240^1241^1242^1243^1244^
119 ;;^1245^1246^1247^1248^1249^1250^1251^1252^1253^1254^1255^1256^1257^1258^1259^1260^1261^1262^1263^1277^1278^
120 ;;^1279^1280^1281^1282^1283^1284^1285^1286^1289^1290^1291^1292^1293^1294^1295^1296^1297^1298^1299^1301^1303^
121 ;;^1304^1305^1306^1308^1309^1310^1311^1312^1313^1314^1316^1317^1318^1319^1321^1322^1324^1325^1326^1327^1328^1329^
122 ;;^1330^1331^1332^1333^1334^1335^1336^1337^1338^1339^1801^1802^1803^1804^1805^1806^1807^1808^1810^1811^1812^
123 ;;^1813^1814^1815^1816^1817^1819^1820^1821^1822^1823^1824^1825^1826^1827^1831^1832^1834^1835^1836^1837^1838^
124 ;;^1839^1840^1842^1843^1844^1845^1846^1847^1853^1854^1855^1856^1857^1858^1859^1860^1861^1862^1863^1864^1865^
125 ;;^1866^1867^1868^1869^1870^1871^1872^1873^1874^1875^1876^1877^1878^
126 ;;
127 ;
128 ;
129 ;-----------------------------------------------------------------------
130 ; 364.7 entries modified:
131 ;
132ENT7 ; output formatter entries in file 364.7 to be included
133 ;
134 ;;^1^2^24^114^144^154^186^197^198^326^333^334^358^359^360^481^482^843^1028^1362^1553^1554^1555^
135 ;;^1556^1557^1558^1559^1560^1561^1562^1563^1564^
136 ;;^1565^1566^1567^1568^1569^1570^1571^1572^1573^1574^1575^1576^1577^1578^
137 ;;
138 ;
139 ;
140 ;-----------------------------------------------------------------------
141DEL6 ; remove output formatter entries in file 364.6 (not re-added)
142 ;
143 ;;^94^154^247^577^578^
144 ;;
145 ;
146 ;-----------------------------------------------------------------------
147DEL7 ; remove output formatter entries in file 364.7 (not re-added)
148 ;
149 ;;^83^109^238^476^477^
150 ;;
151 ;
Note: See TracBrowser for help on using the repository browser.