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

IBY497PO.m

Go to the documentation of this file.
IBY497PO ;ALB/TAZ/KML/YG - Post install routine for patch 497 ; 10 Feb 2013  14:44 PM
 ;;2.0;INTEGRATED BILLING;**497**;21-MAR-94;Build 120
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
EN ;Post Install Routine primary entry point
 D FIXDD
 I $$INSTALDT^XPDUTL("IB*2.0*497")>0 D BMES^XPDUTL("Post-Install already performed.  No need to run again.") Q  ;DBIA#10141   ; don't perform the post installation if the patch has been installed previously 
 N IBY,Y
 F IBY="RMSG","NEWPARAM","REINDEX","RMDEFSTC","RMSSSTC","UPDATE","PROC365","PROC2" D
 . S Y=$$NEWCP^XPDUTL(IBY,IBY_"^IBY497PO")
 . I 'Y D BMES^XPDUTL("ERROR Creating "_IBY_" Checkpoint.")
 Q
 ;
FIXDD ; delete field 365.26/1.01 if it exists
 ; this doesn't do anything for normal install and only affects target account that has field 365.26/1.01 already created
 ; by test version of the build.
 N DIK,DA
 S DIK="^DD(365.26,",DA=1.01,DA(1)=365.26 D ^DIK
 Q
 ;
RMSG ; send site registration message to FSC
 D MES^XPDUTL("Sending site registration message to FSC ... ")
 I '$$PROD^XUPROD(1) D MES^XPDUTL(" N/A - not a production account") G RMSGX  ; only sent reg. message from production account
 D ^IBCNEHLM
RMSGX ;
 Q
 ;
NEWPARAM ;
 ; set new IB site parameter to control length of eIV fields
 ; set IB site parameter DAILY MAILMAN MSG to YES
 ; set IB site parameter DAILY MSG TIME to 07:00
 D MES^XPDUTL("Change values of IB site parameters")
 N DIE,DA,DR,X,Y
 S DIE=350.9,DA=1,DR="62.01///YES;51.02///YES;51.03///0700"
 D ^DIE
 Q
 ;
REINDEX ; run triggers on new eIV fields
 D MES^XPDUTL("Re-index of new eIV fields in the IIV RESPONSE, INSURANCE TYPE,")
 D MES^XPDUTL("INSURANCE BUFFER, and GROUP INSURANCE PLAN files/subfiles ")
 N DA,DIK,FLD,IEN,IEN1,IEN2
 ; file 365, top level
 S DIK="^IBCN(365,"
 F FLD=1.01,1.05,1.06,1.07 S DIK(1)=FLD_"^1" D ENALL^DIK
 ;
 S IEN=0 F  S IEN=$O(^IBCN(365,IEN)) Q:'IEN  D  ; file 365 ien
 .; sub-file 365.03
 .S DA(1)=IEN,DIK="^IBCN(365,"_IEN_",3,"
 .F FLD=.03,.05,.07 S DIK(1)=FLD_"^1" D ENALL^DIK
 .;sub-file 365.26
 .S IEN1=0 F  S IEN1=$O(^IBCN(365,IEN,2,IEN1)) Q:'IEN1  D  ; sub-file 365.02 ien
 ..; sub-file 365.26
 ..S DA(2)=IEN,DA(1)=IEN1,DIK="^IBCN(365,"_IEN_",2,"_IEN1_",6,"
 ..S DIK(1)=".03^1" D ENALL^DIK
 ..Q
 .Q
 ; sub-file 2.312
 S IEN=0 F  S IEN=$O(^DPT(IEN)) Q:'IEN  D  ; file 2 ien
 .S DA(1)=IEN,DIK="^DPT("_IEN_",.312,"
 .S DIK(1)="1^3" D ENALL^DIK
 .S DIK(1)="17^2" D ENALL^DIK
 .S IEN1=0 F  S IEN1=$O(^DPT(IEN,.312,IEN1)) Q:'IEN1  D  ; file 2.312 ien
 ..S IEN2=0 F  S IEN2=$O(^DPT(IEN,.312,IEN1,6,IEN2)) Q:'IEN2  D  ; file 2.322 ien
 ...; sub-file 2.3226
 ...S DA(3)=IEN,DA(2)=IEN1,DA(1)=IEN2,DIK="^DPT("_IEN_",.312,"_IEN1_",6,"_IEN2_",6,"
 ...S DIK(1)=".03^1" D ENALL^DIK
 ...Q
 ..Q
 .Q
 ; file 355.3
 S DIK="^IBA(355.3,"
 S DIK(1)=".03^4" D ENALL^DIK
 S DIK(1)=".04^5" D ENALL^DIK
 ; file 355.33
 S DIK="^IBA(355.33,"
 F FLD=40.02,40.03,60.04 S DIK(1)=FLD_"^2" D ENALL^DIK
 S DIK(1)="60.07^1" D ENALL^DIK
 Q
 ;
RMDEFSTC ;Remove Default Service Type Codes except for Type 30
 ;VARIABLES:
 ;D0 = Site IEN
 ;IEN30 - IEN of Service Type Code 30
 ;STC - List of Service Type Codes
 N DA,DIE,DR,STC,IEN30,FIELD
 S DA=0,DIE=350.9
 D MES^XPDUTL("Removing Default Service Type Codes except for Type 30... ")
 S IEN30=$O(^IBE(365.013,"B",30,""))
 ;
 F DA=$O(^IBE(350.9,DA)) Q:DA=""  D
 . ;Set Default Service Type Code 1 to 30
 . S FIELD=60.01,DR="60.01///30" D ^DIE
 . ;Remove all other Default Service Type Codes
 . F FIELD=60.02:.01:60.11 S STC=$$GET1^DIQ(350.9,DA,FIELD,"I") D
 .. I STC="" Q
 .. S DR=FIELD_"///@"
 .. D ^DIE
 Q
 ;
RMSSSTC ;Remove Default Service Type Codes except for Type 30
 ;VARIABLES:
 ;IEN30 - IEN of Service Type Code 30
 N DA,DIE,DR,FIELD,STC
 S DA=0,DIE=350.9
 D MES^XPDUTL("Removing Site Specific Service Type Codes... ")
 ;
 F DA=$O(^IBE(350.9,DA)) Q:DA=""  D
 . F FIELD=61.01:.01:61.09 S STC=$$GET1^DIQ(350.9,DA,FIELD,"I") D
 .. I STC="" Q
 .. S DR=FIELD_"///@"
 .. D ^DIE
 Q
 ;
UPDATE ;Call option to update Insurance Type File
 ; Schedule through TaskMan to run at night?
 N MSG
 D MES^XPDUTL("Creating Task to update the Insurance Type File... ")
 U IO(0)
UPDATE1 S MSG=$$TASK^IBCNUPD($D(ZTQUEUED)) I MSG["Aborted" D  G UPDATE1
 . S MSG="You MUST schedule this task in order to continue." D MES^XPDUTL(MSG) H 3
 U IO
 D BMES^XPDUTL(MSG)
 Q
 ; PROC365 and PROC2 subroutines will update the data stored at fields redefined in the data dictionary from a SET OF CODES to a Pointer to a File.
 ; The entries that will receive the data conversion are stored at the ELIGIBILITY/BENEFIT subfiles
 ;  of the IIV RESPONSE file (365) and the INSURANCE TYPE subfile (2.312)
 ; The fields will need to be updated with the CODE ien that is stored in the POINTED-TO-FILE.  
 ; The pointed-to-file will be one of the new X12 271 related files.
 ;
PROC365 ;Process entries in the IIV RESPONSE file (365)
 ; Tag FLDLST documents the specific fields that need to be converted
 ;
 D BMES^XPDUTL("Conversion of data at specific fields in the ELIGIBILITY/BENEFIT file (365.02)")
 D BMES^XPDUTL("started at "_$$FMTE^XLFDT($$NOW^XLFDT))
 N IENS,IEN,SIEN,CNT,RSUPDT,VALUE,FILE,FLD,SFILE,SSIEN
 S CNT=0
 ;  need to create zero node of ^XTMP global per SACC 2.3.2.5.2 for proper XTMP clean-up
 I '$D(^XTMP("IBY497PO")) S ^XTMP("IBY497PO",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^file 365.02 and 2.322 data conversions; PROC2 and PROC365 subscripts are last ien processed"
 S IEN=+$G(^XTMP("IBY497PO","PROC365"))    ; restart ien.  in case install is RESTARTED, need to ensure that conversion begins with the next entry
 F  S IEN=$O(^IBCN(365,IEN)) Q:'IEN  D 
 . D 8(IEN,.RSUPDT)
 . S SIEN=0 F  S SIEN=$O(^IBCN(365,IEN,2,SIEN)) Q:'SIEN  D PROCFLDS(365,IEN,SIEN,0)
 . D FILE^DIE("E","RSUPDT")
 . K RSUPDT
 . S CNT=CNT+1
 . S ^XTMP("IBY497PO","PROC365")=IEN  ; record last updated entry
 . I '(CNT#10000) D BMES^XPDUTL("Status: Processed "_CNT_" records")
 D BMES^XPDUTL("Total IIV RESPONSE file PROCESSED "_CNT)
 Q
 ;
PROC2 ; process entries in the ELIGIBILITY/BENEFIT multiple of the INSURANCE TYPE subfile (2.322)
 ; Tag FLDLST documents the specific fields that need to be converted
 ;
 D BMES^XPDUTL("Conversion of data at specific fields in the ELIGIBILITY/BENEFIT file (2.322)")
 D BMES^XPDUTL("started at "_$$FMTE^XLFDT($$NOW^XLFDT))
 N CNT,IENS,DFN,IEN,SIEN,RSUPDT,FLD,FILE,VALUE,SFILE,SSIEN
 S CNT=0
 I '$D(^XTMP("IBY497PO")) S ^XTMP("IBY497PO",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^file 365.02 and 2.322 data conversions; PROC2 and PROC365 subscripts are last ien processed"
 S DFN=+$G(^XTMP("IBY497PO","PROC2"))   ; restart ien.  in case install is RESTARTED, need to ensure that conversion begins with the next entry
 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D
 . S (IEN,SIEN)=0 F  S IEN=$O(^DPT(DFN,.312,IEN)) Q:'IEN  S SIEN=+SIEN F  S SIEN=$O(^DPT(DFN,.312,IEN,6,SIEN)) Q:'SIEN  D PROCFLDS(2,IEN,SIEN,DFN)
 . D FILE^DIE("E","RSUPDT")
 . K RSUPDT
 . S CNT=CNT+1
 . S ^XTMP("IBY497PO","PROC2")=DFN ; record last updated entry
 . I '(CNT#10000) D BMES^XPDUTL("Status: Processed "_CNT_" records")
 D BMES^XPDUTL("Total INSURANCE TYPE subfile PROCESSED "_CNT)
 Q
 ;
PROCFLDS(FILE,IEN,SIEN,DFN) ; go through each of the affected flds and convert data
 ;
 ;  input
 ;    FILE - 365 or 2
 ;    IEN - internal entry number at 2.312 or 365
 ;    SIEN - internal entry number at subfile 365.02 or 2.322
 ;    DFN - ien of PATIENT file (#2)  (equals zero for 365 processing)
 ;
 ;  output
 ;    RSUPDT - FDA array that gets passed to the Fileman DBS filer API
 ;
 S IENS=$S('DFN:SIEN_","_IEN_",",1:SIEN_","_IEN_","_DFN_",")
 S FILE=$S(FILE=365:365.02,1:2.322)
 D 12(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 D 101(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 D 302(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 D 408(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 D 503(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 D 705(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 D 804(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 D 904(FILE,IEN,SIEN,DFN,IENS,.RSUPDT)
 Q
 ;
8(IEN,RSUPDT) ; converts PT. RELATIONSHIP - HIPAA data at 365,8.01
 ; ^IBCN(365,D0,8)= (#8.01) PT. RELATIONSHIP - HIPAA [1P:365.037] ^
 S VALUE=$P($G(^IBCN(365,IEN,8)),U)
 I VALUE]"",+$O(^IBE(365.037,"B",VALUE,"")) S RSUPDT(365,IEN_",",8.01)=VALUE
 Q
 ;
12(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert AUTHORIZATION/CERTIFICATION and IN PLAN data at 365.02,.12, 365.02,.13, 2.322,.12, and 2.322,.13
 ; ^IBCN(365,D0,2,D1,0)= ^^^^^^^^^^^(#.12) AUTHORIZATION/CERTIFICATION [12P:365.033] ^ (#.13) IN PLAN [13P:365.033] ^ 
 ; ^DPT(D0,.312,D1,6,D2,0)= ^^^^^^^^^^^(#.12) AUTHORIZATION/CERTIFICATION [12P:365.033] ^ (#.13) IN PLAN [13P:365.033] ^ 
 F FLD=12,13 D
 . I FILE=365.02 S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,0)),U,FLD)
 . E  S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,0)),U,FLD)
 . I VALUE]"",+$O(^IBE(365.033,"B",VALUE,"")) S RSUPDT(FILE,IENS,"."_FLD)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
101(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert PROCEDURE CODING METHOD data at 365.02, 1.01 and 2.322,1.01
 ; ^IBCN(365,D0,2,D1,1)= (#1.01) PROCEDURE CODING METHOD [1P:365.035] ^
 ; ^DPT(D0,.312,D1,6,D2,1)= (#1.01) PROCEDURE CODING METHOD [1P:365.035] ^
 I FILE=365.02 S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,1)),U)
 E  S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,1)),U)
 I VALUE]"",+$O(^IBE(365.035,"B",VALUE,"")) S RSUPDT(FILE,IENS,1.01)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
302(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert ENTITY TYPE data at 365.02,3.02 and 2.322,3.02
 ; ^IBCN(365,D0,2,D1,3)=  ^ (#3.02) ENTITY TYPE [2P:365.043]
 ; ^DPT(D0,.312,D1,6,D2,3)=  ^ (#3.02) ENTITY TYPE [2P:365.043]
 I FILE=365.02 S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,3)),U,2)
 E  S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,3)),U,2)
 I VALUE]"",+$O(^IBE(365.043,"B",VALUE,"")) S RSUPDT(FILE,IENS,3.02)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
408(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert LOCATION QUALIFIER data at 365.02,4.08 and 2.322,4.08
 ; ^IBCN(365,D0,2,D1,4)= ^^^^^^^(#4.08) LOCATION QUALIFIER [8P:365.034] 
 ; ^DPT(D0,.312,D1,6,D2,4)= ^^^^^^^(#4.08) LOCATION QUALIFIER  [8P:365.034]
 I FILE=365.02 S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,4)),U,8)
 E  S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,4)),U,8)
 I VALUE]"",+$O(^IBE(365.034,"B",VALUE,"")) S RSUPDT(FILE,IENS,4.08)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
503(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert REFERENCE ID QUALIFIER data at 365.02,5.03 and 2.322,5.03
 ; ^IBCN(365,D0,2,D1,5)= ^^ (#5.03) REFERENCE ID QUALIFIER [3P:365.028] 
 ; ^DPT(D0,.312,D1,6,D2,5)= ^^ (#5.03) REFERENCE ID QUALIFIER [3P:365.028] 
 I FILE=365.02 S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,5)),U,3)
 E  S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,5)),U,3)
 I VALUE]"",+$O(^IBE(365.028,"B",VALUE,"")) S RSUPDT(FILE,IENS,5.03)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
705(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert UNITS OF MEASUREMENT and DELIVERY PATTERN data at 365.27,.05 and .09, 2.3227,.05, and .09
 ; ^IBCN(365,D0,2,D1,7,D2,0)= ^^^^(#.05) UNITS OF MEASUREMENT [5P:365.029]^^^^ (#.09) DELIVERY PATTERN [9P:365.036] ^ 
 ; ^DPT(D0,.312,D1,6,D2,7,D3,0)= ^^^^(#.05) UNITS OF MEASUREMENT [5P:365.029]^^^^ (#.09) DELIVERY PATTERN [9P:365.036] ^ 
 I FILE=365.02 S SFILE=365.27,SSIEN=0 F  S SSIEN=$O(^IBCN(365,IEN,2,SIEN,7,SSIEN)) Q:'SSIEN  F FLD=5,9 S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,7,SSIEN,0)),U,FLD) D MORE705
 I FILE=2.322 S SFILE=2.3227,SSIEN=0 F  S SSIEN=$O(^DPT(DFN,.312,IEN,6,SIEN,7,SSIEN)) Q:'SSIEN  F FLD=5,9 S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,7,SSIEN,0)),U,FLD) D MORE705
 Q
 ;
MORE705 ;
 I VALUE]"",+$O(^IBE($S(FLD=5:365.029,1:365.036),"B",VALUE,"")) S RSUPDT(SFILE,SSIEN_","_IENS,".0"_FLD)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
804(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert DATE FORMAT data at 365.28,.04 and 2.3228,.04
 ; ^IBCN(365,D0,2,D1,8,D2,0)= ^^^ (#.04) DATE FORMAT [4P:365.032]
 ; ^DPT(D0,.312,D1,6,D2,8,D3,0)= ^^^ (#.04) DATE FORMAT [4P:365.032]
 I FILE=365.02 S SFILE=365.28,SSIEN=0 F  S SSIEN=$O(^IBCN(365,IEN,2,SIEN,8,SSIEN)) Q:'SSIEN  S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,8,SSIEN,0)),U,4) D MORE804
 I FILE=2.322 S SFILE=2.3228,SSIEN=0 F  S SSIEN=$O(^DPT(DFN,.312,IEN,6,SIEN,8,SSIEN)) Q:'SSIEN  S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,8,SSIEN,0)),U,4) D MORE804
 Q
 ;
MORE804 ;
 I VALUE]"",+$O(^IBE(365.032,"B",VALUE,"")) S RSUPDT(SFILE,SSIEN_","_IENS,.04)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
904(FILE,IEN,SIEN,DFN,IENS,RSUPDT) ; procedure will convert QUALIFIER data at 365.29,.04 and 2.3229,.04
 ; ^IBCN(365,D0,2,D1,9,D2,0)= ^^^(#.04) QUALIFIER [4P:365.044]
 ; ^DPT(D0,.312,D1,6,D2,9,D3,0)= ^^^(#.04) QUALIFIER [4P:365.044]
 I FILE=365.02 S SFILE=365.29,SSIEN=0 F  S SSIEN=$O(^IBCN(365,IEN,2,SIEN,9,SSIEN)) Q:'SSIEN  S VALUE=$P($G(^IBCN(365,IEN,2,SIEN,9,SSIEN,0)),U,4) D MORE904
 I FILE=2.322 S SFILE=2.3229,SSIEN=0 F  S SSIEN=$O(^DPT(DFN,.312,IEN,6,SIEN,9,SSIEN)) Q:'SSIEN  S VALUE=$P($G(^DPT(DFN,.312,IEN,6,SIEN,9,SSIEN,0)),U,4) D MORE904
 Q
 ;
MORE904 ;
 I VALUE]"",+$O(^IBE(365.044,"B",VALUE,"")) S RSUPDT(SFILE,SSIEN_","_IENS,.04)=VALUE  ;update field with ien of valid code in X12 file; otherwise leave with invalid code
 Q
 ;
FLDLST ; these are the DD fields that were modified from a set of codes to a Pointer to a file
 ;;file#^field#^field label^pointed-to file#
 ;;365^8.01^PT. RELATIONSHIP - HIPAA^365.037
 ;;365.02^.12^AUTHORIZATION/CERTIFICATION^365.033
 ;;365.02^.13^IN PLAN^365.033
 ;;365.02^1.01^PROCEDURE CODING METHOD^365.035
 ;;365.02^3.02^ENTITY TYPE^365.043
 ;;365.02^4.08^LOCATION QUALIFIER^365.034
 ;;365.02^5.03^REFERENCE ID QUALIFIER^365.028
 ;;365.27^.05^UNITS OF MEASUREMENT^365.029
 ;;365.27^.09^DELIVERY PATTERN^365.036
 ;;365.28^.04^DATE FORMAT^365.032
 ;;365.29^.04^QUALIFIER^365.044
 ;;2.322^.12^AUTHORIZATION/CERTIFICATION^365.033
 ;;2.322^.13^IN PLAN^365.033
 ;;2.322^1.01^PROCEDURE CODING METHOD^365.035
 ;;2.322^3.02^ENTITY TYPE^365.043
 ;;2.322^4.08^LOCATION QUALIFIER^365.034
 ;;2.322^5.03^REFERENCE ID QUALIFIER^365.028
 ;;2.3227^.05^UNITS OF MEASUREMENT^365.029
 ;;2.3227^.09^DELIVERY PATTERN^365.036
 ;;2.3228^.04^DATE FORMAT^365.032
 ;;2.3229^.04^QUALIFIER^365.044
 ;;
 Q
 ;