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

IBCNHUT2.m

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