- IBCNHUT2 ;ALB/GEF - HPID/OEID UTILITIES ;11-MAR-14
- ;;2.0;INTEGRATED BILLING;**519,549**;21-MAR-94;Build 54
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; this routine contains HL7 utilities for the HPID project.
- Q
- ;
- PUR ;
- ; This section handles the purging of the HPID/OEID data stored in the
- ; HPID/OEID Transmission Queue file (#367.1) and in the HPID/OEID Response file (#367).
- ; This is called from a nightly tasked routine IBAMTC. Data created within the last 2 weeks
- ; cannot be purged. Only requested data that has a NIF-ID response received will be purged.
- ; Unsolicited responses will also be purged as will those with a status of EXR (Exception
- ; Report Reject), whether they have a NIF ID or not.
- ; The system will not purge entries with no response, entries that have dropped to
- ; an exception queue, or entries with a response less than 14 days old.
- ; Uses this x-ref on file 367: ^IBCNH(367,"E",future purge date/time,ien)=""
- ; and finds the corresponding entry in file 367.1 with: ^IBCNH(367,ien,0)=2nd piece is ien in 367.1
- ;
- ; IB*2.0*549 - This segment also verifies that the HL7 logical link is up and running properly
- ;
- N ENDDT,TQIEN,RSIEN,DA,DIK,RDTA,STDT,RST,TST,ID,RTYP
- S ENDDT=$$FMADD^XLFDT(DT,-15)
- S STDT="" F S STDT=$O(^IBCNH(367,"E",STDT)) Q:STDT=""!($P(STDT,".",1)>ENDDT) D
- .S RSIEN="" F S RSIEN=$O(^IBCNH(367,"E",STDT,RSIEN)) Q:RSIEN="" D
- ..; double check to make sure they are both correct status with status R having a NIF ID before deleting
- ..S RDTA=$G(^IBCNH(367,RSIEN,0))
- ..S RST=$P(RDTA,U,5),RTYP=$P(RDTA,U,3)
- ..I $E(RST)'="R"&(RST'="EXR") Q
- ..; as of 6/23/14, do not purge EXR
- ..Q:RST="EXR"
- ..S TQIEN=$P(RDTA,U,2)
- ..I TQIEN'="" S TST=$P($G(^IBCNH(367.1,TQIEN,0)),U,4) I $E(TST)'="R" Q
- ..; if this is a requested response, make sure we got a NIF
- ..I RTYP="R",RST="R" Q:'$D(^IBCNH(367,"D",8,RSIEN))
- ..I RTYP="R",RST="R" S ID=$O(^IBCNH(367,"D",8,RSIEN,"")) Q:$P($G(^IBCNH(367,RSIEN,1,ID,0)),U,2)=""
- ..; OK TO DELETE
- ..S DA=RSIEN,DIK="^IBCNH(367," D ^DIK
- ..Q:TQIEN=""
- ..S DA=TQIEN,DIK="^IBCNH(367.1," D ^DIK
- ;
- K ENDDT,TQIEN,RSIEN,DA,DIK,RDTA,STDT,ID,RTYP
- ;
- ; IB*2.0*549 Set up for verifying logical link
- D SETUPVER
- Q
- ;
- EXT ; kick off HL7 queries of each insurance company sent to the NIF for the initial HPID extract
- ; called from option IBCNH HPID NIF BATCH QUERY. To be run once FSC notifies site that they are
- ; ready - ie. they have received and processed the data extracts and have the NIF ID's for each
- ; insurance company.
- ;
- N IBN,DIE,DA,DR,C
- ; activate HPID/OEID flag in IB SITE PARAMS
- S DIE="^IBE(350.9,",DA=$P($G(^IBE(350.9,0)),U,3),DR=70.01_"///"_1 D ^DIE
- S IBN=0,C=0 F S IBN=$O(^DIC(36,IBN)) Q:'IBN D
- .; update display with status
- .S C=C+1 I C#20 W "."
- .; don't send if we already have a pending message for this insurance company
- .Q:$D(^IBCNH(367.1,"INS",IBN))
- .; don't send if we already have a NIF ID for this insurance company
- .Q:$$NIF^IBCNHUT1(IBN)
- .; don't send if there are no patients associated with this ins.co. OR if there are no groups associated with this insurance co.
- .Q:'$D(^DPT("AB",IBN))
- .Q:'$D(^IBA(355.3,"B",IBN))
- .; only active insurance companies
- .Q:$P($G(^DIC(36,IBN,0)),U,5)=1
- .; from here we can kick off the HL7 message.
- .D SEND^IBCNHHLO(IBN)
- K IBN,DIE,DA,DR,C
- Q
- ;
- FM36(INS,DATA,TQN) ; updates file 36, 8 node with data received from the NIF
- ; INS = insurance company ien (REQUIRED)
- ; DATA=String containing HPID data in this format: HPID^CHP/SHP^PARENT^NIF ID
- ; NIF = NIF ID for insurance company
- ; TQN=ien of entry in file 367.1 (if data came from a requested response)
- ; returns "-1^Error code^Error reason" if entry not added and Processing Status if added/updated
- ;
- N DIC,DR,DA,DIE,I,X
- Q:INS="" "-1^ED^DATABASE Error: Not a valid Insurance Company ien!"
- ; validate Vista Unique ID and HPID data format
- Q:'$D(^DIC(36,INS)) "-1^ED^Error: Insurance ien does NOT exist at this site!"
- ; don't update insurance file if Legacy ID's have changed since we sent the request
- Q:$$LEG($G(TQN),INS) "-1^EL^LEGACY ID Error: Legacy ID Changed!"
- ; ready to update file 36, fields 8.01, 8.02, 8.03 and 8.04 with DATA
- S DIE="^DIC(36,",DA=INS,DR="" K DIC
- F I=2:1:4 S DR=DR_"8.0"_I_"///^S X=$P(DATA,U,"_I_");"
- D ^DIE
- ; add HPID separately since if it fails input transform nothing else updates
- S DR="8.01///^S X=$P(DATA,U)" D ^DIE
- K DIE,DR,I,INS,X,LID,DIC
- Q DA_"^R^RESPONSE PROCESSED: File 36 Updated"
- ;
- FM71(INS,HLID) ; adds entry to file 367.1 (HPID/OEID TRANSMISSION QUEUE) and file 367 (HPID/OEID RESPONSE)
- ; INS =insurance company ien (required)
- ; HLID = message control ID number assigned by HL7 when HL7 message was created (required)
- ; returns ien of entry added to file 367.1
- ;
- N DIC,DR,DA,DIE,Y,IDN,DATA,TQN,RSN,X,DLAYGO
- Q:INS="" "-1^Error: Not a valid Insurance Company ien!"
- Q:HLID="" "-1^Error: No HL7 Control Number defined!"
- S DIC="^IBCNH(367.1,",DIC(0)="LS",X=$P($G(^IBCNH(367.1,0)),U,3)+1,DLAYGO=367.1 D ^DIC
- Q:Y=-1 "-1^Error: HPID QUEUE entry NOT added!"
- S TQN=+Y
- ; add stub record in file 367
- S DIC="^IBCNH(367,",DIC(0)="LS",X=HLID,DLAYGO=367 D ^DIC
- ; update 367 with additional fields.
- S RSN=+Y
- I Y>0 S DIE=DIC,DA=+Y,DR=".01///"_HLID_";.02///"_TQN_";.03///R" K DIC D ^DIE
- ; now update new 367.1 entry with insurance company data fields on 2 node, response info and status of A for AWAITING RESPONSE
- Q:'$$R36(INS,.DATA)
- S DIE="^IBCNH(367.1,",DA=TQN,DR="" K DIC
- S DR=".02///"_INS_";"_".04///"_"A"_";.07///"_RSN
- F I=1:1:8 S DR=DR_";2.0"_I_"///^S X=$P(DATA(1),U,"_I_")"
- D ^DIE
- ; update ID multiple with ID data
- F IDN=1:1:10 I $P($G(DATA(2)),U,IDN)'="" D
- .; create ID multiple
- .S DIC="^IBCNH(367.1,"_TQN_",1,",DA(1)=TQN,DIC(0)="LS" S X="`"_IDN,DLAYGO=367.1 D ^DIC Q:Y=-1
- .; add ID data to new multiple entry
- .S DIE=DIC,DA=+Y,DR=".01///"_IDN_";.02///^S X=$P($G(DATA(2)),U,"_IDN_");.03///"_$P($G(DATA(3)),U,IDN) K DIC
- .D ^DIE
- K DIC,DR,DA,DIE,Y,IDN,DATA,RSN,X,DLAYGO
- Q TQN
- ;
- FM367(IEN,DATA,ID,QL) ; updates entry to file 367 (HPID/OEID RESPONSE) for requested responses,
- ; or creates a new entry for unsolicited responses.
- ; IEN = ien of existing entry in file 367 (will only exist for requested responses)
- ; DATA = data string containing response data for 0 node (NOTE: You do not have to pass all this data, but it must be in this format):
- ; HLID^TQN^RTY^INS NAME^NPS^STAT D/T^UID^PARENT HPID^CHP or SHP
- ; TQN = Transaction ien in file 367.1 (HPID/OEID TRANSMISSION QUEUE), null for unsolicited responses
- ; RTY = Response Type: R for Requested or U for Unsolicited
- ; NPS = Processing status at NIF, either R for Response Processed or X for Exception Report or EXR for Rejected
- ; HLID = control ID of HL7 message (required if this is an unsolicited response, not req'd if you have ien)
- ; ID = Data string of ID data sent from NIF. MUST BE in this format:
- ;(ie. HPID must always be 9th piece, NIF must be 8, If no EDI numbers received, those pieces will be null, etc.):
- ; EDI ID NUMBER-PROF^EDI ID NUMBER-INST^EDI PROF SECONDARY ID(1)^EDI PROF SECONDARY ID(2)^EDI INST SECONDARY ID(1)^EDI INST SECONDARY ID(2)^VA NATIONAL ID^NIF ID^HPID/OEID^VISTA UNIQUE ID
- ; QL=string of secondary ID qualifiers, in this format: ^^QUAL1(PS1)^QUAL2(PS2)^QAUL3(IS1)^QUAL4(IS2)
- ; RETURNS: IEN of file 367 entry that was updated, or -1 for error condition
- ;
- N DIC,DR,DA,DIE,Y,IDN,HLID,RTY,INS,TQN,PS,NPS,DLAYGO
- S DATA=$G(DATA),ID=$G(ID),QL=$G(QL)
- S HLID=$P($G(DATA),U),RTY=$P($G(DATA),U,3)
- I RTY="R",$G(IEN)="" Q "-1^Error: No HPID/OEID Response ien!"
- I $G(IEN)="",$G(HLID)="" Q "-1^Error: No HPID/OEID Response and no HL7 ien!"
- ; if NIF processing status is not R, update response status only and quit
- Q:$P(DATA,U,5)'="R" $$STAT^IBCNHUT1(IEN,$P(DATA,U,5))
- ; create new entry in 367 for unsolicited responses and update file 36 using NIF ID
- I RTY="U" S IEN=$$UNSOL^IBCNHUT1(HLID,RTY,ID,DATA)
- Q:$P(IEN,U)=-1 "-1^Error: HPID RESPONSE entry NOT added!"
- ; create and update ID multiple
- F IDN=1:1:10 I $P(ID,U,IDN)'="" D
- .S DIC="^IBCNH(367,"_IEN_",1,",DA(1)=IEN,DIC(0)="LS",X="`"_IDN,DLAYGO=367 D ^DIC Q:Y=-1
- .S DIE=DIC,DA=+Y,DR=".01///"_IDN_";.02///^S X=$P(ID,U,"_IDN_");.03///"_$P(QL,U,IDN) K DIC
- .D ^DIE
- ; update 367 with additional fields.
- S DIE="^IBCNH(367,",DA=IEN,DR=""
- F I=3,4,7,8,9 S DR=DR_".0"_I_"///^S X=$P(DATA,U,"_I_");"
- D ^DIE
- ; now update the insurance company entry in file 36 for requested responses. Use the insurance
- ; ien that was sent in the original request.
- ; Unsolicited response are updated via previous call to $$UNSOL^IBCNHUT1
- Q:RTY="U" IEN
- S INS="",TQN=$P($G(^IBCNH(367,IEN,0)),U,2) S:TQN'="" INS=$P(^IBCNH(367.1,TQN,0),U,2)
- S PS=$$FM36(INS,$P(ID,U,9)_U_$P(DATA,U,9)_U_$P(DATA,U,8)_U_$P(ID,U,8),TQN)
- ; update field .05 in file 367 (PROCESSING STATUS)
- Q $$STAT^IBCNHUT1(IEN,$P(PS,U,2))
- ;
- R36(INS,DATA) ; this function gathers all the insurance company data we need to send to the NIF
- ; INS= ien of insurance company entry (required)
- ; DATA=name of array to store data results in
- ; Returns: DATA(0) = Insurance Ien^Insurance Company Name^INACTIVE FLAG^UID^NIF ID^HPID/OEID^CHP/SHP^PARENT HPID
- ; DATA(1) = STREET ADDRESS 1^STR AD2^CITY^STATE^ZIP^BILLING CO NAME^TYPE OF COVERAGE^PHONE#
- ; DATA(2) = string of ID's in this format:
- ; EDI ID NUMBER-PROF^EDI ID NUMBER-INST^EDI PROF SECONDARY ID(1)^EDI PROF SECONDARY ID(2)^EDI INST SECONDARY ID(1)^EDI INST SECONDARY ID(2)^VA NATIONAL ID^NIF ID^HPID/OEID^VISTA UNIQUE ID
- ; DATA(3) = string of ID qualifiers in this format: ^^QUAL1(PS1)^QUAL2(PS2)^QAUL3(IS1)^QUAL4(IS2)
- ;
- N ID,QL,I,ND
- F I=0:1:3 S DATA(I)=""
- S ND(.11)=$G(^DIC(36,INS,.11)),ND(0)=$G(^DIC(36,INS,0))
- F I=1,2,4:1:7 S DATA(1)=DATA(1)_$P(ND(.11),U,I)_U
- S DATA(1)=DATA(1)_$P(ND(0),U,13)_U_$P($G(^DIC(36,INS,.13)),U)
- S ID(7)=$$VID^IBCNHUT1(INS),ND(6)=$G(^DIC(36,INS,6)),ND(3)=$G(^DIC(36,INS,3))
- S ID(3)=$P(ND(6),U,6),ID(4)=$P(ND(6),U,8),ID(5)=$P(ND(6),U,2),ID(6)=$P(ND(6),U,4)
- S QL(3)=$P(ND(6),U,5),QL(4)=$P(ND(6),U,7),QL(5)=$P(ND(6),U),QL(6)=$P(ND(6),U,3)
- S ID(1)=$P(ND(3),U,2),ID(2)=$P(ND(3),U,4),ID(10)=$$UID^IBCNHUT1(INS)
- S DATA(0)=INS_U_$P(ND(0),U)_U_$P(ND(0),U,5)_U_$$UID^IBCNHUT1(INS)_U_$$NIF^IBCNHUT1(INS)_U_$$HPD^IBCNHUT1(INS)_U_$$SHP^IBCNHUT1(INS)_U_$$PHP^IBCNHUT1(INS)
- S ID(8)=$P(DATA(0),U,5),ID(9)=$P(DATA(0),U,6)
- F I=1:1:10 S DATA(2)=DATA(2)_$G(ID(I))_U
- F I=1:1:6 S DATA(3)=DATA(3)_$G(QL(I))_U
- K ID,QL,I,ND
- Q 1
- ;
- SETUPVER ; Set up verifying of IB NIF TCP logical link
- ; IB*2.0*549 added method
- ;
- N CURRTIME,MTIME
- N DIFROM,LLIEN,NIFTM,XMDUN,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,XX,YY,ZTRTN,ZTDESC
- N ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
- ;
- I '$$PROD^XUPROD(1) G SETUPVRX ; Only check for stuck messages in production
- ;
- S NIFTM=$$GET1^DIQ(350.9,"1,",51.29,"I") ; Get IB NIF TCP data
- I NIFTM="" G SETUPVRX ; MM message time is not defined
- S LLIEN=$O(^HLCS(870,"B","IB NIF TCP","")) ; IB NIF TCP Logical Link
- I LLIEN="" G SETUPVRX
- ;
- S CURRTIME=$P($H,",",2) ; current $H time
- S MTIME=DT_"."_NIFTM ; build a FileMan date/time
- S MTIME=$$FMTH^XLFDT(MTIME) ; convert to $H format
- S MTIME=$P(MTIME,",",2) ; $H time of MM message
- ;
- ; If the current time is after the MailMan message time, then schedule the message for tomorrow at that time.
- ; Otherwise, schedule it for later today.
- S ZTDTH=$S(CURRTIME>MTIME:$H+1,1:+$H)_","_MTIME
- ;
- ; Set up the other TaskManager variables
- S ZTRTN="VERFYLNK^IBCNHUT2" ; The tag that we want TASKMAN to call
- S ZTDESC="Verify HL7 Logical link 'IB NIF TCP' is running"
- S ZTIO=""
- S ZTSAVE("LLIEN")=""
- S ZTSAVE("NIFTM")=""
- D ^%ZTLOAD ; Call TaskManager
- I '$G(ZTSK) D ; Task # is not okay
- . ;
- . ; Send a MailMan message if this Task could not get scheduled
- . S MGRP="VHAeInsuranceRapidResponse@domain.ext"
- . ;
- . S XMSUB=" Daily verification of IB NIF TCP link Not Scheduled"
- . S XMTEXT="XMTEXT("
- . S XMTEXT(1)="TaskManager could not schedule the daily verification of IB NIF TCP link"
- . S XMTEXT(2)="at the specified time of "_$E(NIFTM,1,2)_":"_$E(NIFTM,3,4)_"."
- . D ^XMD
- ;
- SETUPVRX ;
- Q
- ;
- VERFYLNK ; Verify IB NIF TCP entry in the HL Logical Link file (#870) on a daily basis
- ; IB*2.0*549 added Method
- ; Input - LLIEN [thru ZTSAVE("LLIEN")]
- ; NIFTM [thru ZTSAVE("NIFTM")]
- ;
- N FLG,IEN,X,XMSUB,XMTEXT,XMY,XX,YY
- S IEN=$O(^HLMA("AC","O",LLIEN,""))
- I IEN="" S FLG=1
- E D
- . H 30
- . S FLG=$S('$D(^HLMA("AC","O",LLIEN,IEN)):1,1:0) ; Processing observed / No processing
- ;
- I 'FLG D ; Link is apparently not processing records
- . S XX=$$SITE^VASITE()
- . S YY=$P(XX,"^",2)_"(#"_$P(XX,"^",1)_")"
- . S X="No activity seen in link"
- . ;
- . ; Send a MailMan message if link is not processing records
- . S XMY("VHAeInsuranceRapidResponse@domain.ext")=""
- . S XMY(.5)=""
- . ;
- . S XMSUB=" Daily verification of IB NIF TCP link: "_X
- . S XMTEXT="XMTEXT("
- . S XMTEXT(1)="Daily verification of IB NIF TCP was unsuccessful ("_X_")"
- . S XMTEXT(2)="at the specified time of "_$E(NIFTM,1,2)_":"_$E(NIFTM,3,4)_" for site: "_YY_"."
- . D ^XMD
- Q
- ;
- LEG(TQN,INS) ; function to determine if legacy ID's changed since we sent them out
- ; returns a 0 if Legacy ID has not changed and a "1^EL^Error: Legacy ID Changed!" if it has.
- ;
- N N,TID,I
- Q:TQN="" 0
- Q:INS="" 0
- F I=1,2 D
- .S N=$O(^IBCNH(367.1,TQN,1,"B",I,"")) Q:N=""
- .S TID(I)=$P($G(^IBCNH(367.1,TQN,1,N,0)),U,2)
- Q:$G(TID(1))'=$P($G(^DIC(36,INS,3)),U,2) "1^EL^Error: Legacy ID Changed!"
- Q:$G(TID(2))'=$P($G(^DIC(36,INS,3)),U,4) "1^EL^Error: Legacy ID Changed!"
- K N,TID,I
- Q 0
- ;
- SMAIL(MGRP,XMSUB,MSG) ; Summary email
- ; IB*2.0*549 Send e-mail
- N DIFROM,XMDUN,XMDUZ,XMMG,XMTEXT,XMY,XMZ
- S XMY(MGRP)=""
- S XMTEXT=MSG
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNHUT2 14085 printed Jan 18, 2025@03:17:02 Page 2
- IBCNHUT2 ;ALB/GEF - HPID/OEID UTILITIES ;11-MAR-14
- +1 ;;2.0;INTEGRATED BILLING;**519,549**;21-MAR-94;Build 54
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; this routine contains HL7 utilities for the HPID project.
- +5 QUIT
- +6 ;
- PUR ;
- +1 ; This section handles the purging of the HPID/OEID data stored in the
- +2 ; HPID/OEID Transmission Queue file (#367.1) and in the HPID/OEID Response file (#367).
- +3 ; This is called from a nightly tasked routine IBAMTC. Data created within the last 2 weeks
- +4 ; cannot be purged. Only requested data that has a NIF-ID response received will be purged.
- +5 ; Unsolicited responses will also be purged as will those with a status of EXR (Exception
- +6 ; Report Reject), whether they have a NIF ID or not.
- +7 ; The system will not purge entries with no response, entries that have dropped to
- +8 ; an exception queue, or entries with a response less than 14 days old.
- +9 ; Uses this x-ref on file 367: ^IBCNH(367,"E",future purge date/time,ien)=""
- +10 ; and finds the corresponding entry in file 367.1 with: ^IBCNH(367,ien,0)=2nd piece is ien in 367.1
- +11 ;
- +12 ; IB*2.0*549 - This segment also verifies that the HL7 logical link is up and running properly
- +13 ;
- +14 NEW ENDDT,TQIEN,RSIEN,DA,DIK,RDTA,STDT,RST,TST,ID,RTYP
- +15 SET ENDDT=$$FMADD^XLFDT(DT,-15)
- +16 SET STDT=""
- FOR
- SET STDT=$ORDER(^IBCNH(367,"E",STDT))
- if STDT=""!($PIECE(STDT,".",1)>ENDDT)
- QUIT
- Begin DoDot:1
- +17 SET RSIEN=""
- FOR
- SET RSIEN=$ORDER(^IBCNH(367,"E",STDT,RSIEN))
- if RSIEN=""
- QUIT
- Begin DoDot:2
- +18 ; double check to make sure they are both correct status with status R having a NIF ID before deleting
- +19 SET RDTA=$GET(^IBCNH(367,RSIEN,0))
- +20 SET RST=$PIECE(RDTA,U,5)
- SET RTYP=$PIECE(RDTA,U,3)
- +21 IF $EXTRACT(RST)'="R"&(RST'="EXR")
- QUIT
- +22 ; as of 6/23/14, do not purge EXR
- +23 if RST="EXR"
- QUIT
- +24 SET TQIEN=$PIECE(RDTA,U,2)
- +25 IF TQIEN'=""
- SET TST=$PIECE($GET(^IBCNH(367.1,TQIEN,0)),U,4)
- IF $EXTRACT(TST)'="R"
- QUIT
- +26 ; if this is a requested response, make sure we got a NIF
- +27 IF RTYP="R"
- IF RST="R"
- if '$DATA(^IBCNH(367,"D",8,RSIEN))
- QUIT
- +28 IF RTYP="R"
- IF RST="R"
- SET ID=$ORDER(^IBCNH(367,"D",8,RSIEN,""))
- if $PIECE($GET(^IBCNH(367,RSIEN,1,ID,0)),U,2)=""
- QUIT
- +29 ; OK TO DELETE
- +30 SET DA=RSIEN
- SET DIK="^IBCNH(367,"
- DO ^DIK
- +31 if TQIEN=""
- QUIT
- +32 SET DA=TQIEN
- SET DIK="^IBCNH(367.1,"
- DO ^DIK
- End DoDot:2
- End DoDot:1
- +33 ;
- +34 KILL ENDDT,TQIEN,RSIEN,DA,DIK,RDTA,STDT,ID,RTYP
- +35 ;
- +36 ; IB*2.0*549 Set up for verifying logical link
- +37 DO SETUPVER
- +38 QUIT
- +39 ;
- EXT ; kick off HL7 queries of each insurance company sent to the NIF for the initial HPID extract
- +1 ; called from option IBCNH HPID NIF BATCH QUERY. To be run once FSC notifies site that they are
- +2 ; ready - ie. they have received and processed the data extracts and have the NIF ID's for each
- +3 ; insurance company.
- +4 ;
- +5 NEW IBN,DIE,DA,DR,C
- +6 ; activate HPID/OEID flag in IB SITE PARAMS
- +7 SET DIE="^IBE(350.9,"
- SET DA=$PIECE($GET(^IBE(350.9,0)),U,3)
- SET DR=70.01_"///"_1
- DO ^DIE
- +8 SET IBN=0
- SET C=0
- FOR
- SET IBN=$ORDER(^DIC(36,IBN))
- if 'IBN
- QUIT
- Begin DoDot:1
- +9 ; update display with status
- +10 SET C=C+1
- IF C#20
- WRITE "."
- +11 ; don't send if we already have a pending message for this insurance company
- +12 if $DATA(^IBCNH(367.1,"INS",IBN))
- QUIT
- +13 ; don't send if we already have a NIF ID for this insurance company
- +14 if $$NIF^IBCNHUT1(IBN)
- QUIT
- +15 ; don't send if there are no patients associated with this ins.co. OR if there are no groups associated with this insurance co.
- +16 if '$DATA(^DPT("AB",IBN))
- QUIT
- +17 if '$DATA(^IBA(355.3,"B",IBN))
- QUIT
- +18 ; only active insurance companies
- +19 if $PIECE($GET(^DIC(36,IBN,0)),U,5)=1
- QUIT
- +20 ; from here we can kick off the HL7 message.
- +21 DO SEND^IBCNHHLO(IBN)
- End DoDot:1
- +22 KILL IBN,DIE,DA,DR,C
- +23 QUIT
- +24 ;
- FM36(INS,DATA,TQN) ; updates file 36, 8 node with data received from the NIF
- +1 ; INS = insurance company ien (REQUIRED)
- +2 ; DATA=String containing HPID data in this format: HPID^CHP/SHP^PARENT^NIF ID
- +3 ; NIF = NIF ID for insurance company
- +4 ; TQN=ien of entry in file 367.1 (if data came from a requested response)
- +5 ; returns "-1^Error code^Error reason" if entry not added and Processing Status if added/updated
- +6 ;
- +7 NEW DIC,DR,DA,DIE,I,X
- +8 if INS=""
- QUIT "-1^ED^DATABASE Error: Not a valid Insurance Company ien!"
- +9 ; validate Vista Unique ID and HPID data format
- +10 if '$DATA(^DIC(36,INS))
- QUIT "-1^ED^Error: Insurance ien does NOT exist at this site!"
- +11 ; don't update insurance file if Legacy ID's have changed since we sent the request
- +12 if $$LEG($GET(TQN),INS)
- QUIT "-1^EL^LEGACY ID Error: Legacy ID Changed!"
- +13 ; ready to update file 36, fields 8.01, 8.02, 8.03 and 8.04 with DATA
- +14 SET DIE="^DIC(36,"
- SET DA=INS
- SET DR=""
- KILL DIC
- +15 FOR I=2:1:4
- SET DR=DR_"8.0"_I_"///^S X=$P(DATA,U,"_I_");"
- +16 DO ^DIE
- +17 ; add HPID separately since if it fails input transform nothing else updates
- +18 SET DR="8.01///^S X=$P(DATA,U)"
- DO ^DIE
- +19 KILL DIE,DR,I,INS,X,LID,DIC
- +20 QUIT DA_"^R^RESPONSE PROCESSED: File 36 Updated"
- +21 ;
- FM71(INS,HLID) ; adds entry to file 367.1 (HPID/OEID TRANSMISSION QUEUE) and file 367 (HPID/OEID RESPONSE)
- +1 ; INS =insurance company ien (required)
- +2 ; HLID = message control ID number assigned by HL7 when HL7 message was created (required)
- +3 ; returns ien of entry added to file 367.1
- +4 ;
- +5 NEW DIC,DR,DA,DIE,Y,IDN,DATA,TQN,RSN,X,DLAYGO
- +6 if INS=""
- QUIT "-1^Error: Not a valid Insurance Company ien!"
- +7 if HLID=""
- QUIT "-1^Error: No HL7 Control Number defined!"
- +8 SET DIC="^IBCNH(367.1,"
- SET DIC(0)="LS"
- SET X=$PIECE($GET(^IBCNH(367.1,0)),U,3)+1
- SET DLAYGO=367.1
- DO ^DIC
- +9 if Y=-1
- QUIT "-1^Error: HPID QUEUE entry NOT added!"
- +10 SET TQN=+Y
- +11 ; add stub record in file 367
- +12 SET DIC="^IBCNH(367,"
- SET DIC(0)="LS"
- SET X=HLID
- SET DLAYGO=367
- DO ^DIC
- +13 ; update 367 with additional fields.
- +14 SET RSN=+Y
- +15 IF Y>0
- SET DIE=DIC
- SET DA=+Y
- SET DR=".01///"_HLID_";.02///"_TQN_";.03///R"
- KILL DIC
- DO ^DIE
- +16 ; now update new 367.1 entry with insurance company data fields on 2 node, response info and status of A for AWAITING RESPONSE
- +17 if '$$R36(INS,.DATA)
- QUIT
- +18 SET DIE="^IBCNH(367.1,"
- SET DA=TQN
- SET DR=""
- KILL DIC
- +19 SET DR=".02///"_INS_";"_".04///"_"A"_";.07///"_RSN
- +20 FOR I=1:1:8
- SET DR=DR_";2.0"_I_"///^S X=$P(DATA(1),U,"_I_")"
- +21 DO ^DIE
- +22 ; update ID multiple with ID data
- +23 FOR IDN=1:1:10
- IF $PIECE($GET(DATA(2)),U,IDN)'=""
- Begin DoDot:1
- +24 ; create ID multiple
- +25 SET DIC="^IBCNH(367.1,"_TQN_",1,"
- SET DA(1)=TQN
- SET DIC(0)="LS"
- SET X="`"_IDN
- SET DLAYGO=367.1
- DO ^DIC
- if Y=-1
- QUIT
- +26 ; add ID data to new multiple entry
- +27 SET DIE=DIC
- SET DA=+Y
- SET DR=".01///"_IDN_";.02///^S X=$P($G(DATA(2)),U,"_IDN_");.03///"_$PIECE($GET(DATA(3)),U,IDN)
- KILL DIC
- +28 DO ^DIE
- End DoDot:1
- +29 KILL DIC,DR,DA,DIE,Y,IDN,DATA,RSN,X,DLAYGO
- +30 QUIT TQN
- +31 ;
- FM367(IEN,DATA,ID,QL) ; updates entry to file 367 (HPID/OEID RESPONSE) for requested responses,
- +1 ; or creates a new entry for unsolicited responses.
- +2 ; IEN = ien of existing entry in file 367 (will only exist for requested responses)
- +3 ; DATA = data string containing response data for 0 node (NOTE: You do not have to pass all this data, but it must be in this format):
- +4 ; HLID^TQN^RTY^INS NAME^NPS^STAT D/T^UID^PARENT HPID^CHP or SHP
- +5 ; TQN = Transaction ien in file 367.1 (HPID/OEID TRANSMISSION QUEUE), null for unsolicited responses
- +6 ; RTY = Response Type: R for Requested or U for Unsolicited
- +7 ; NPS = Processing status at NIF, either R for Response Processed or X for Exception Report or EXR for Rejected
- +8 ; HLID = control ID of HL7 message (required if this is an unsolicited response, not req'd if you have ien)
- +9 ; ID = Data string of ID data sent from NIF. MUST BE in this format:
- +10 ;(ie. HPID must always be 9th piece, NIF must be 8, If no EDI numbers received, those pieces will be null, etc.):
- +11 ; EDI ID NUMBER-PROF^EDI ID NUMBER-INST^EDI PROF SECONDARY ID(1)^EDI PROF SECONDARY ID(2)^EDI INST SECONDARY ID(1)^EDI INST SECONDARY ID(2)^VA NATIONAL ID^NIF ID^HPID/OEID^VISTA UNIQUE ID
- +12 ; QL=string of secondary ID qualifiers, in this format: ^^QUAL1(PS1)^QUAL2(PS2)^QAUL3(IS1)^QUAL4(IS2)
- +13 ; RETURNS: IEN of file 367 entry that was updated, or -1 for error condition
- +14 ;
- +15 NEW DIC,DR,DA,DIE,Y,IDN,HLID,RTY,INS,TQN,PS,NPS,DLAYGO
- +16 SET DATA=$GET(DATA)
- SET ID=$GET(ID)
- SET QL=$GET(QL)
- +17 SET HLID=$PIECE($GET(DATA),U)
- SET RTY=$PIECE($GET(DATA),U,3)
- +18 IF RTY="R"
- IF $GET(IEN)=""
- QUIT "-1^Error: No HPID/OEID Response ien!"
- +19 IF $GET(IEN)=""
- IF $GET(HLID)=""
- QUIT "-1^Error: No HPID/OEID Response and no HL7 ien!"
- +20 ; if NIF processing status is not R, update response status only and quit
- +21 if $PIECE(DATA,U,5)'="R"
- QUIT $$STAT^IBCNHUT1(IEN,$PIECE(DATA,U,5))
- +22 ; create new entry in 367 for unsolicited responses and update file 36 using NIF ID
- +23 IF RTY="U"
- SET IEN=$$UNSOL^IBCNHUT1(HLID,RTY,ID,DATA)
- +24 if $PIECE(IEN,U)=-1
- QUIT "-1^Error: HPID RESPONSE entry NOT added!"
- +25 ; create and update ID multiple
- +26 FOR IDN=1:1:10
- IF $PIECE(ID,U,IDN)'=""
- Begin DoDot:1
- +27 SET DIC="^IBCNH(367,"_IEN_",1,"
- SET DA(1)=IEN
- SET DIC(0)="LS"
- SET X="`"_IDN
- SET DLAYGO=367
- DO ^DIC
- if Y=-1
- QUIT
- +28 SET DIE=DIC
- SET DA=+Y
- SET DR=".01///"_IDN_";.02///^S X=$P(ID,U,"_IDN_");.03///"_$PIECE(QL,U,IDN)
- KILL DIC
- +29 DO ^DIE
- End DoDot:1
- +30 ; update 367 with additional fields.
- +31 SET DIE="^IBCNH(367,"
- SET DA=IEN
- SET DR=""
- +32 FOR I=3,4,7,8,9
- SET DR=DR_".0"_I_"///^S X=$P(DATA,U,"_I_");"
- +33 DO ^DIE
- +34 ; now update the insurance company entry in file 36 for requested responses. Use the insurance
- +35 ; ien that was sent in the original request.
- +36 ; Unsolicited response are updated via previous call to $$UNSOL^IBCNHUT1
- +37 if RTY="U"
- QUIT IEN
- +38 SET INS=""
- SET TQN=$PIECE($GET(^IBCNH(367,IEN,0)),U,2)
- if TQN'=""
- SET INS=$PIECE(^IBCNH(367.1,TQN,0),U,2)
- +39 SET PS=$$FM36(INS,$PIECE(ID,U,9)_U_$PIECE(DATA,U,9)_U_$PIECE(DATA,U,8)_U_$PIECE(ID,U,8),TQN)
- +40 ; update field .05 in file 367 (PROCESSING STATUS)
- +41 QUIT $$STAT^IBCNHUT1(IEN,$PIECE(PS,U,2))
- +42 ;
- R36(INS,DATA) ; this function gathers all the insurance company data we need to send to the NIF
- +1 ; INS= ien of insurance company entry (required)
- +2 ; DATA=name of array to store data results in
- +3 ; Returns: DATA(0) = Insurance Ien^Insurance Company Name^INACTIVE FLAG^UID^NIF ID^HPID/OEID^CHP/SHP^PARENT HPID
- +4 ; DATA(1) = STREET ADDRESS 1^STR AD2^CITY^STATE^ZIP^BILLING CO NAME^TYPE OF COVERAGE^PHONE#
- +5 ; DATA(2) = string of ID's in this format:
- +6 ; EDI ID NUMBER-PROF^EDI ID NUMBER-INST^EDI PROF SECONDARY ID(1)^EDI PROF SECONDARY ID(2)^EDI INST SECONDARY ID(1)^EDI INST SECONDARY ID(2)^VA NATIONAL ID^NIF ID^HPID/OEID^VISTA UNIQUE ID
- +7 ; DATA(3) = string of ID qualifiers in this format: ^^QUAL1(PS1)^QUAL2(PS2)^QAUL3(IS1)^QUAL4(IS2)
- +8 ;
- +9 NEW ID,QL,I,ND
- +10 FOR I=0:1:3
- SET DATA(I)=""
- +11 SET ND(.11)=$GET(^DIC(36,INS,.11))
- SET ND(0)=$GET(^DIC(36,INS,0))
- +12 FOR I=1,2,4:1:7
- SET DATA(1)=DATA(1)_$PIECE(ND(.11),U,I)_U
- +13 SET DATA(1)=DATA(1)_$PIECE(ND(0),U,13)_U_$PIECE($GET(^DIC(36,INS,.13)),U)
- +14 SET ID(7)=$$VID^IBCNHUT1(INS)
- SET ND(6)=$GET(^DIC(36,INS,6))
- SET ND(3)=$GET(^DIC(36,INS,3))
- +15 SET ID(3)=$PIECE(ND(6),U,6)
- SET ID(4)=$PIECE(ND(6),U,8)
- SET ID(5)=$PIECE(ND(6),U,2)
- SET ID(6)=$PIECE(ND(6),U,4)
- +16 SET QL(3)=$PIECE(ND(6),U,5)
- SET QL(4)=$PIECE(ND(6),U,7)
- SET QL(5)=$PIECE(ND(6),U)
- SET QL(6)=$PIECE(ND(6),U,3)
- +17 SET ID(1)=$PIECE(ND(3),U,2)
- SET ID(2)=$PIECE(ND(3),U,4)
- SET ID(10)=$$UID^IBCNHUT1(INS)
- +18 SET DATA(0)=INS_U_$PIECE(ND(0),U)_U_$PIECE(ND(0),U,5)_U_$$UID^IBCNHUT1(INS)_U_$$NIF^IBCNHUT1(INS)_U_$$HPD^IBCNHUT1(INS)_U_$$SHP^IBCNHUT1(INS)_U_$$PHP^IBCNHUT1(INS)
- +19 SET ID(8)=$PIECE(DATA(0),U,5)
- SET ID(9)=$PIECE(DATA(0),U,6)
- +20 FOR I=1:1:10
- SET DATA(2)=DATA(2)_$GET(ID(I))_U
- +21 FOR I=1:1:6
- SET DATA(3)=DATA(3)_$GET(QL(I))_U
- +22 KILL ID,QL,I,ND
- +23 QUIT 1
- +24 ;
- SETUPVER ; Set up verifying of IB NIF TCP logical link
- +1 ; IB*2.0*549 added method
- +2 ;
- +3 NEW CURRTIME,MTIME
- +4 NEW DIFROM,LLIEN,NIFTM,XMDUN,XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,XX,YY,ZTRTN,ZTDESC
- +5 NEW ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
- +6 ;
- +7 ; Only check for stuck messages in production
- IF '$$PROD^XUPROD(1)
- GOTO SETUPVRX
- +8 ;
- +9 ; Get IB NIF TCP data
- SET NIFTM=$$GET1^DIQ(350.9,"1,",51.29,"I")
- +10 ; MM message time is not defined
- IF NIFTM=""
- GOTO SETUPVRX
- +11 ; IB NIF TCP Logical Link
- SET LLIEN=$ORDER(^HLCS(870,"B","IB NIF TCP",""))
- +12 IF LLIEN=""
- GOTO SETUPVRX
- +13 ;
- +14 ; current $H time
- SET CURRTIME=$PIECE($HOROLOG,",",2)
- +15 ; build a FileMan date/time
- SET MTIME=DT_"."_NIFTM
- +16 ; convert to $H format
- SET MTIME=$$FMTH^XLFDT(MTIME)
- +17 ; $H time of MM message
- SET MTIME=$PIECE(MTIME,",",2)
- +18 ;
- +19 ; If the current time is after the MailMan message time, then schedule the message for tomorrow at that time.
- +20 ; Otherwise, schedule it for later today.
- +21 SET ZTDTH=$SELECT(CURRTIME>MTIME:$HOROLOG+1,1:+$HOROLOG)_","_MTIME
- +22 ;
- +23 ; Set up the other TaskManager variables
- +24 ; The tag that we want TASKMAN to call
- SET ZTRTN="VERFYLNK^IBCNHUT2"
- +25 SET ZTDESC="Verify HL7 Logical link 'IB NIF TCP' is running"
- +26 SET ZTIO=""
- +27 SET ZTSAVE("LLIEN")=""
- +28 SET ZTSAVE("NIFTM")=""
- +29 ; Call TaskManager
- DO ^%ZTLOAD
- +30 ; Task # is not okay
- IF '$GET(ZTSK)
- Begin DoDot:1
- +31 ;
- +32 ; Send a MailMan message if this Task could not get scheduled
- +33 SET MGRP="VHAeInsuranceRapidResponse@domain.ext"
- +34 ;
- +35 SET XMSUB=" Daily verification of IB NIF TCP link Not Scheduled"
- +36 SET XMTEXT="XMTEXT("
- +37 SET XMTEXT(1)="TaskManager could not schedule the daily verification of IB NIF TCP link"
- +38 SET XMTEXT(2)="at the specified time of "_$EXTRACT(NIFTM,1,2)_":"_$EXTRACT(NIFTM,3,4)_"."
- +39 DO ^XMD
- End DoDot:1
- +40 ;
- SETUPVRX ;
- +1 QUIT
- +2 ;
- VERFYLNK ; Verify IB NIF TCP entry in the HL Logical Link file (#870) on a daily basis
- +1 ; IB*2.0*549 added Method
- +2 ; Input - LLIEN [thru ZTSAVE("LLIEN")]
- +3 ; NIFTM [thru ZTSAVE("NIFTM")]
- +4 ;
- +5 NEW FLG,IEN,X,XMSUB,XMTEXT,XMY,XX,YY
- +6 SET IEN=$ORDER(^HLMA("AC","O",LLIEN,""))
- +7 IF IEN=""
- SET FLG=1
- +8 IF '$TEST
- Begin DoDot:1
- +9 HANG 30
- +10 ; Processing observed / No processing
- SET FLG=$SELECT('$DATA(^HLMA("AC","O",LLIEN,IEN)):1,1:0)
- End DoDot:1
- +11 ;
- +12 ; Link is apparently not processing records
- IF 'FLG
- Begin DoDot:1
- +13 SET XX=$$SITE^VASITE()
- +14 SET YY=$PIECE(XX,"^",2)_"(#"_$PIECE(XX,"^",1)_")"
- +15 SET X="No activity seen in link"
- +16 ;
- +17 ; Send a MailMan message if link is not processing records
- +18 SET XMY("VHAeInsuranceRapidResponse@domain.ext")=""
- +19 SET XMY(.5)=""
- +20 ;
- +21 SET XMSUB=" Daily verification of IB NIF TCP link: "_X
- +22 SET XMTEXT="XMTEXT("
- +23 SET XMTEXT(1)="Daily verification of IB NIF TCP was unsuccessful ("_X_")"
- +24 SET XMTEXT(2)="at the specified time of "_$EXTRACT(NIFTM,1,2)_":"_$EXTRACT(NIFTM,3,4)_" for site: "_YY_"."
- +25 DO ^XMD
- End DoDot:1
- +26 QUIT
- +27 ;
- LEG(TQN,INS) ; function to determine if legacy ID's changed since we sent them out
- +1 ; returns a 0 if Legacy ID has not changed and a "1^EL^Error: Legacy ID Changed!" if it has.
- +2 ;
- +3 NEW N,TID,I
- +4 if TQN=""
- QUIT 0
- +5 if INS=""
- QUIT 0
- +6 FOR I=1,2
- Begin DoDot:1
- +7 SET N=$ORDER(^IBCNH(367.1,TQN,1,"B",I,""))
- if N=""
- QUIT
- +8 SET TID(I)=$PIECE($GET(^IBCNH(367.1,TQN,1,N,0)),U,2)
- End DoDot:1
- +9 if $GET(TID(1))'=$PIECE($GET(^DIC(36,INS,3)),U,2)
- QUIT "1^EL^Error: Legacy ID Changed!"
- +10 if $GET(TID(2))'=$PIECE($GET(^DIC(36,INS,3)),U,4)
- QUIT "1^EL^Error: Legacy ID Changed!"
- +11 KILL N,TID,I
- +12 QUIT 0
- +13 ;
- SMAIL(MGRP,XMSUB,MSG) ; Summary email
- +1 ; IB*2.0*549 Send e-mail
- +2 NEW DIFROM,XMDUN,XMDUZ,XMMG,XMTEXT,XMY,XMZ
- +3 SET XMY(MGRP)=""
- +4 SET XMTEXT=MSG
- +5 DO ^XMD
- +6 QUIT