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