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

IBY547PR.m

Go to the documentation of this file.
IBY547PR ;ALB/WCJ - Pre-Installation for IB patch 547 ; 1/7/16 4:33pm
 ;;2.0;INTEGRATED BILLING;**547**;21-MAR-94;Build 119
 ;;Per VA Directive 6402, this routine should not be modified.
 ;
 ; delete all output formatter (O.F.) data elements included in build
 D DELOF,RATETYPE,RFIINTAD
 Q
 ;
RATETYPE ;Update all active rate types to be transmittable electronically
 ;FILE 399.3 field .1
 ;
 N IBIEN,DA,DR,DIE
 S IBIEN=0
 F  S IBIEN=$O(^DGCR(399.3,IBIEN)) Q:'IBIEN  D
 . I '$$GET1^DIQ(399.3,IBIEN_",",.03) D
 .. S DIE=399.3,DR=".1///1",DA=IBIEN
 .. D ^DIE
 K DIE,DR,DA
 Q
 ;
RFIINTAD ;Add necessary entries for the IB RFI HL7 interface.
 I '$O(^HL(771.5,"B",2.6,0)) D
 .N DIC,X,DIK,DA,DIE,DR,Y,DTOUT,DUOUT
 .D MES^XPDUTL("Adding entrie(s) to the HL7 VERSION file (#771.5)")
 .K DO
 .S DIC="^HL(771.5,",DIC(0)="",X=2.6
 .S DIC("DR")="2////"_$$FIND1^DIC(771.8,,,"HEALTH LEVEL SEVEN")
 .D FILE^DICN
 .K DIC,DIE,DR,DTOUT,DUOUT,X,DIK
 .D MES^XPDUTL("........'Version 2.6' added.")
 ;
 I '$O(^HL(771.2,"B","EHC",0)) D
 .N DIC,X,DIK,DA,DIE,DR,Y,DTOUT,DUOUT
 .D MES^XPDUTL("Adding entrie(s) to the HL7 Message Type file (#771.2)")
 .K DO
 .S DIC="^HL(771.2,",DIC(0)="",X="EHC"
 .S DIC("DR")="2////Health Care Invoice"
 .D FILE^DICN                                ;Supported by DBIA 2162
 .S DIK="^HL(771.2,",DA=+Y D IX1^DIK         ;Supported by DBIA 2162
 .K DIE,DR,DTOUT,DUOUT,X,DIK
 .;
 .K DO
 .S DA(1)=+Y,DIC=DIC_DA(1)_","_"""V"""_",",DIC(0)="L"
 .S X=$$FIND1^DIC(771.5,,,2.6)               ;Lookup IEN for 2.6
 .D FILE^DICN                                ;Supported by DBIA 2162
 .K DIC,DA,DIE,DR,Y,DTOUT,DUOUT,DIC,X
 .D MES^XPDUTL("........'EHC-Health Care Invoice' added.")
 ;
 I '$O(^HL(779.001,"B","E12",0)) D
 .N D0,DIC,X,DIK,DA,DIE,DR,DTOUT,DUOUT,Y
 .D MES^XPDUTL("Adding entrie(s) to the HL7 Event Type Code file (#779.001)")
 .K D0
 .S DIC="^HL(779.001,",DIC(0)="",X="E12"
 .S DIC("DR")="2////Request Additional Information"
 .D FILE^DICN
 .S DIK="^HL(779.001,",DA=+Y D IX1^DIK
 .K DA,DIE,DR,DTOUT,DUOUT,X,DIK
 .;
 .K D0
 .S DA(1)=+Y,DIC=DIC_DA(1)_",1,",DIC(0)="L"
 .S X=$$FIND1^DIC(771.5,,,2.6)               ;Lookup IEN for 2.6
 .D FILE^DICN
 .S DIK="^HL(779.001,",DA=+Y D IX1^DIK
 .K DIC,DA,DIE,DR,DTOUT,DUOUT,DIC,X,DIK,Y
 .D MES^XPDUTL("........'E12-Request Additional Information' added.")
 ;
 I '$O(^HL(779.005,"B","EHC_E12",0)) D
 .N D0,DIC,X,DIK,DA,DIE,DR,DTOUT,DUOUT,Y
 .D MES^XPDUTL("Adding entrie(s) to the HL7 MESSAGE STRUCTURE CODE file (#779.005)")
 .K D0
 .S DIC="^HL(779.005,",DIC(0)="",X="EHC_E12"
 .S DIC("DR")="2////E12"
 .D FILE^DICN
 .K DIE,DR,DTOUT,DUOUT,X,DIK
 .;
 .K D0
 .S DA(1)=+Y,DIC=DIC_DA(1)_",1,",DIC(0)="L"
 .S X=$$FIND1^DIC(771.5,,,2.6)               ;Lookup IEN for 2.6
 .D FILE^DICN
 .K DIC,DA,DIE,DR,DTOUT,DUOUT,X,DIK
 .D MES^XPDUTL("........'EHC_E12' added.")
 ;
 ;Add interface user to file 200.  Supported by IA#4677.
 N IEN200
 D MES^XPDUTL("Adding entrie(s) to the New Person file (#200)")
 S IEN200=$$CREATE^XUSAP("INTERFACE,IB RFI","")
 I +IEN200=0 D MES^XPDUTL("........'Interface,IB RFI' already exists.")
 I +IEN200>0 D MES^XPDUTL("........'Interface,IB RFI' added.")
 I IEN200<0 D MES^XPDUTL("........'ERROR: Interface,IB RFI' NOT added.")
 Q
 ;
INCLUDE(FILE,Y) ; function to determine if O.F. entry should be included in the build
 ; FILE=5,6,7 indicating file 364.x
 ; Y=ien to file
 NEW OK,LN,TAG,DATA
 S OK=0
 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
 Q OK
 ;
 ;Delete edited entries to insure clean install of new entries
 ;Delete obsolete entries.
DELOF   ; Delete included OF entries
 NEW FILE,DIK,LN,TAG,TAGLN,DATA,PCE,DA,Y
 F FILE=5,6,7 S DIK="^IBA(364."_FILE_"," D
 . F TAG="ENT"_FILE,"DEL"_FILE D
 .. F LN=2:1 S TAGLN=TAG_"+"_LN,DATA=$P($T(@TAGLN),";;",2) Q:DATA=""  D
 ... F PCE=2:1 S DA=$P(DATA,U,PCE) Q:'DA  I $D(^IBA("364."_FILE,DA,0)) D ^DIK
 Q
 ;
 ; Example for ENT5, ENT6, ENT7, DEL5, DEL6, and DEL7:
 ;;^195^254^259^269^324^325^
 ; Note:  Must have beginning and ending up-carat
 ;
 ; 364.5 entries modified:
 ;
ENT5 ; OF entries in file 364.5 to be included
 ;
 ;;
 ;
 ;-----------------------------------------------------------------------
 ; 364.6 entries modified:
 ;    1 - CI2.2
 ;    3 - PRV.11
 ;    6 - CI2A.2.9
 ;    7 - CI2A.5
 ;    9 - CI2A.7
 ;   10 - CI2.6.9
 ;   11 - CI2.8
 ;   12 - CI2A.8
 ;   13 - CI3A.1.9
 ;   16 - CI2.7
 ;   17 - CI2A.3
 ;   18 - CI3A.2
 ;   22 - CI2.4
 ;   26 - CI2.3
 ;   29 - PT1.3
 ;   37 - PT1.11
 ;   41 - PT1.15
 ;   43 - PT2.2
 ;   59 - CL1.19
 ;   65 - CI2.4
 ;   66 - CL1.26
 ;   67 - CL1.27
 ;   96 - OI1.6
 ;   98 - OI1.4
 ;   99 - OI2.3
 ;  100 - OI1.5
 ;  101 - OI2.4
 ;  102 - OI2.5
 ;  106 - OI1A.3
 ;  109 - OI2.8
 ;  110 - OI2.9
 ;  117 - PRF.8
 ;  127 - INS.6
 ;  132 - INS.11
 ;  136 - RX1.5
 ;  146 - CI3A.99.9
 ;  155 - OI1A.99.9
 ;  174 - SUB.6
 ;  177 - PRV.3
 ;  189 - CI3.2
 ;  190 - CI3.3
 ;  195 - OI1A.4
 ;  196 - CI1.8
 ;  581 - RX1.9
 ;  784 - CL1.34
 ;  785 - CL1.35
 ;  789 - CI2A.6
 ;  794 - CI3A.3
 ;  804 - OI1A.5
 ;  805 - OI1.7
 ;  806 - OI1A.8
 ;  809 - COB1.3
 ;  810 - COB1.4
 ;  811 - COB1.5
 ;  812 - COB1.6
 ;  939 - OPR.12
 ;  944 - OPR.5
 ;  952 - CL1.36
 ;  956 - OI1A.9
 ;  957 - CI3A.4
 ;  968 - PRV.10
 ;  971 - SUB.9
 ;  980 - PRF.27
 ;  981 - PRF.28
 ;  988 - OI2.10
 ;  999 - CI3A.6
 ; 1000 - CI3A.5
 ; 1004 - CI1.11
 ; 1005 - OI1.8
 ; 1010 - PRF.26
 ; 1016 - CI2.6
 ; 1029 - PT1.17
 ; 1030 - PT1.18
 ; 1034 - CL1A.4
 ; 1043 - SUB2.4
 ; 1065 - OI1.9
 ; 1194 - SUB.11
 ; 1289 - OI5.4
 ; 1290 - OI5.5
 ; 1315 - CI1.9
 ; 1316 - CI1.7
 ; 1317 - CI1.13
 ; 1802 - CI6.3
 ; 1804 - CI6.5
 ; 1861 - PRV-2
 ; 1862 - UB1.5
 ; 1863 - UB1.6
 ; 1864 - UB1.7
 ; 1865 - UB1.8
 ; 1866 - UB1.9
 ; 1867 - UB1.10
 ; 1868 - UB1.11
 ; 1869 - UB1.12
 ; 1870 - UB1.13
 ; 1871 - UB1.14
 ; 1872 - UB1.15
 ; 1873 - UB1.16
 ; 1874 - UB1.17
 ; 1875 - UB1.18
 ; 1876 - OPR1.13
 ; 1913 - CL1A.14
 ; 1927 - PRV1.4
 ; 1928 - PRV1.5
 ; 1929 - PRV1.6
 ; 1930 - PRV1.7
 ; 1931 - PRV1.8
 ; 1966 - CI3A.7
 ; 1967 - CI3A.8
 ; 1968 - CI3A.9
 ; 2059 - LDAT.9
 ; 2060 - LDAT.10
 ; 2204 - OI1A.6
 ; 2205 - OI1A.7
 ; 2253 - CI2A.1
 ; 2254 - CI2A.2
 ; 2255 - CI3A.1
 ; 2256 - OI1A.1
 ; 2257 - OI1A.2
 ;
ENT6 ; O.F. entries in file 364.6 to be included
 ;
 ;;^1^3^6^7^9^10^11^12^13^16^17^18^22^26^29^37^41^43^59^65^66^67^
 ;;^96^98^99^100^101^102^106^109^110^117^127^132^136^146^155^174^177^
 ;;^189^190^195^196^581^784^785^789^794^804^805^806^809^810^
 ;;^811^812^939^944^952^956^957^968^971^980^981^988^999^1000^
 ;;^1004^1005^1010^1016^1029^1030^1034^1043^1065^1194^1289^
 ;;^1290^1315^1316^1317^1802^1804^1861^1862^1863^1864^1865^
 ;;^1866^1867^1868^1869^1870^1871^1872^1873^1874^1875^1876^
 ;;^1927^1928^1929^1930^1931^1966^1967^1968^2059^2060^2204^2205^2253^
 ;;^2254^2255^2256^2257^
 ;
 ;-----------------------------------------------------------------------
 ;
 ;   27 - DC1.2
 ;   28 - CL1-16
 ;   37 - PC1.1.9
 ;   77 - CL1.14
 ;   98 - CL1.13.9
 ;  100 - CL1.15.9
 ;  809 - COB1.3
 ; 1015 - GEN.7
 ; 1579 - DC1.4
 ; 1627 - PRV1.4
 ; 1951 - CI2A.1
 ; 1952 - CI2A.2
 ; 1953 - CI3A.1
 ; 1954 - OI1A.1
 ; 1955 - OI1A.2
 ;
ENT7 ; O.F. entries in file 364.7 to be included
 ;
 ;;^27^28^37^77^98^100^809^1015^1198^1305^1579^1627^1951^1952^1953^1954^1955^
 ;
 ;-----------------------------------------------------------------------
 ; 364.5 entries deleted:
 ;
DEL5    ; remove O.F. entries in file 364.5 (not re-added)
 ;
 ;;
 ;
 ;-----------------------------------------------------------------------
 ; 364.6 entries deleted:
 ;
 ;    5 - CI2.6
 ;   14 - CI3.7
 ;   15 - CI3.6
 ;  104 - OI1.6
 ;  105 - OI1.7
 ;  107 - OI1.9
 ;  111 - OI1.10
 ;  191 - CI3.4
 ;  814 - COB1.8
 ;  815 - COB1.9
 ;  891 - COB1.10
 ;  961 - COB1.11
 ;  962 - COB1.12
 ;  964 - COB1.13
 ;  987 - CI3.12
 ; 1097 - CI1A.10
 ; 1098 - CI1A.11
 ; 1099 - CI1A.12
 ; 1100 - CI1A.13
 ; 1101 - CI1A.14
 ; 1102 - CI1A.15
 ; 1103 - CI1A.16
 ; 1104 - CI1A.17
 ; 1195 - SUB.13
 ; 1196 - SUB.14
 ; 1214 - SUB2.13
 ; 1215 - SUB2.14
 ; 1216 - SUB2.15
 ; 1217 - SUB2.16
 ; 1232 - OPR2.10
 ; 1233 - OPR2.11
 ; 1242 - OPR3.10
 ; 1243 - OPR3.11
 ; 1252 - OPR4.10
 ; 1253 - OPR4.11
 ; 1260 - OPR5.8
 ; 1261 - OPR5.9
 ; 1262 - OPR5.10
 ; 1263 - OPR5.11
 ; 1285 - OPR8.10
 ; 1286 - OPR8.11
 ; 1296 - OI5.11
 ; 1297 - OI5.12
 ; 1298 - OI5.13
 ; 1299 - OI5.14
 ; 1805 - CI6.6
 ; 1806 - CI6.7
 ; 1807 - CI6.8
 ; 1808 - CI6.9
 ; 2029 - SUB2.17
 ; 2030 - SUB2.18
 ; 2031 - SUB2.18
 ; 2032 - SUB2.20
 ; 2033 - SUB2.21
 ; 2034 - SUB2.22
 ; 2208 - PRV1.12
 ;
DEL6    ; remove O.F. entries in file 364.6 (not re-added)
 ;
 ;;^5^14^15^104^105^107^111^191^814^815^891^961^962^964^987^
 ;;^1097^1098^1099^1100^1101^1102^1103^1104^1195^1196^
 ;;^1214^1215^1216^1217^1232^1233^1242^1243^1252^1253^
 ;;^1260^1261^1262^1263^1285^1286^1296^1297^1298^1299^
 ;;^1805^1806^1807^1808^2029^2030^2031^2032^2033^2034^2208^
 ;
 ;-----------------------------------------------------------------------
 ; 364.7 entries deleted:
 ;
 ;    3 - CI2.6
 ;   22 - CI3.6
 ;   23 - CI3.7
 ;  122 - OI1.6
 ;  124 - OI1.7
 ;  125 - OI1.9
 ;  130 - 0I1.10
 ;  133 - CI3.4
 ;  378 - CI1A.10
 ;  379 - CI1A.11
 ;  380 - CI1A.12
 ;  381 - CI1A.13
 ;  382 - CI1A.14
 ;  383 - CI1A.15
 ;  384 - CI1A.16
 ;  385 - CI1A.17
 ;  392 - SUB.13
 ;  393 - SUB.14
 ;  410 - SUB2.13
 ;  411 - SUB2.14
 ;  412 - SUB2.15
 ;  413 - SUB2.16
 ;  428 - OPR2.10
 ;  429 - OPR2.11
 ;  438 - OPR3.10
 ;  439 - OPR3.11
 ;  451 - OPR8.10
 ;  452 - OPR8.11
 ;  462 - OI5.11
 ;  463 - OI5.12
 ;  464 - OI5.13
 ;  465 - OI5.14
 ;  650 - OPR5.8
 ;  651 - OPR5.9
 ;  652 - OPR5.10
 ;  653 - OPR5.11
 ;  657 - OPR4.11
 ;  662 - OPR4.10
 ;  844 - COB1.8
 ;  845 - COB1.9
 ;  951 - COB1.10
 ;  955 - COB1.11
 ;  956 - COB1.13
 ;  983 - COB1.12
 ;  990 - CI3.12
 ; 1505 - CI6.6
 ; 1506 - CI6.7
 ; 1507 - CI6.8
 ; 1508 - CI6.9
 ; 1728 - SUB2.17
 ; 1729 - SUB2.18
 ; 1730 - SUB2.19
 ; 1731 - SUB2.20
 ; 1732 - SUB2.21
 ; 1733 - SUB2.22
 ; 1908 - PRV1.12
 ;
DEL7    ; remove O.F. entries in file 364.7 (not re-added)
 ;
 ;;^3^22^23^122^124^125^130^133^378^379^380^381^382^383^
 ;;^384^385^392^393^410^411^412^413^428^429^438^439^451^
 ;;^452^462^463^464^465^650^651^652^653^657^662^844^845^
 ;;^951^955^956^983^990^1505^1506^1507^1508^1728^1729^
 ;;^1730^1731^1732^1733^1908^
 ;
 ;-----------------------------------------------------------------------
 ;