IBCNEUT7 ;DAOU/ALA - IIV MISC. UTILITIES ;14-OCT-2015
;;2.0;INTEGRATED BILLING;**184,549,579,582,601,732**;21-MAR-94;Build 13
;;Per VA Directive 6402, this routine should not be modified.
;
;**Program Description**
; This program contains some general utilities or functions
; IB*2*601/DM XMITOK() Gate-keeper routine moved to IBCNETST
;
Q
;
DEATH(DFN,DOD) ;EP
; IB*2.0*549 added method
;IB*2.0*732/DTG start cleaned up and added comment
; Sets the INSURANCE EXPIRATION DATE (file 2.312, field 3) for all active
; insurances of the selected patient to be the date of death
;
; NOTE: this tag is called by a trigger on the DATE OF DEATH (file 2, field .351)
;IB*2.0*732/DTG end cleaned up and added comment
;
; Input: DFN - IEN of the patient to term insurances for
; DOD - Internal date of death (file 2, field .351) of the patient
N MTIME,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
S MTIME=$$NOW^XLFDT() ; Fileman date/time
S ZTDTH=$$FMTH^XLFDT(MTIME) ; Convert to $H format
;
; Set up the other TaskManager variables
S ZTRTN="DEATH2^IBCNEUT7"
S ZTDESC="eIV Auto Termination of Policies for deceased patients"
S ZTIO=""
S ZTSAVE("DFN")="",ZTSAVE("DOD")=""
D ^%ZTLOAD ; Call TaskManager
Q
;
DEATH2 ;EP from TaskMan
; IB*2.0*549 added method
;IB*732/DTG - start cleaned up and added comment
; NOTE: This tag is called by DEATH^IBCNEUT7
;
; Sets the INSURANCE EXPIRATION DATE (file 2.312, field 3) for all active
; insurances of the selected patient to be the date of death
;IB*732/DTG - end cleaned up and added comment
;
; IB*2.0*579 - Also sets the 'COVERED BY HEALTH INSURANCE' to 'N' (file 2, field .3192)
; if it's not already set to 'N'
; Input: DFN - IEN of the patient to term insurances for
; DOD - Internal date of death (file 2, field .351) of the patient
;IB*732/DTG - start DODX should be the Date of Death (DOD), removing DODX
;N EXPDT,DA,DEACT,DODX,FDA,HCOV,IBIEN ; IB*2.0*579 - added DEACT,HCOV
N EXPDT,DA,DEACT,FDA,HCOV,IBIEN ; IB*2.0*579 - added DEACT,HCOV
S DEACT=0 ; IB*2.0*579 - added line
;S DODX=$P($$FMADD^XLFDT(DOD,1),".",1) ; Date of Death +1
S IBIEN=0
F S IBIEN=$O(^DPT(DFN,.312,IBIEN)) Q:+IBIEN=0 D
. ;S EXPDT=$$GET1^DIQ(2.312,IBIEN_","_DFN_",",3,"I") ; Policy Expiration Date
. S EXPDT=$$GET1^DIQ(2.312,IBIEN_","_DFN_",",3,"I") ; Insurance Expiration Date
. Q:EXPDT'="" ; Policy has an expiration date
. L +^DPT(DFN,.312,IBIEN):5
. I '$T D Q ; Send email IB SUPERVISOR users
. . N EDT,MLGRP,MSG,PNM,SSN,SUBJECT,XMY
. . S SUBJECT="eIV: Policy Expiration for deceased patient"
. . S MLGRP=$$MGRP^IBCNEUT5
. . S PNM=$$GET1^DIQ(2,DFN,.01)
. . ;S EDT=$$FMTE^XLFDT(DODX,"2DZ")
. . S EDT=$$FMTE^XLFDT(DOD,"2DZ")
. . S SSN=$$GET1^DIQ(2,DFN,.09),SSN=$E(SSN,6,9)
. . S MSG(1)=PNM_" "_SSN_" was just marked as deceased. Action Needed:"
. . S MSG(2)=" Update the patient's active policies and enter and expiration date of "_EDT_"."
. . D GETPER("IB SUPERVISOR",.XMY)
. . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
. ;
. ; Set Policy expiration date to be date of death
. S DEACT=1 ; IB*2.0*579 - added line
. K DA,FDA
. S DA=IBIEN,DA(1)=DFN
. S FDA(2.312,DA_","_DA(1)_",",1.05)=$$NOW^XLFDT() ; Date Last Edited
. S FDA(2.312,DA_","_DA(1)_",",1.06)=.5 ; Last Edited By
. ;S FDA(2.312,DA_","_DA(1)_",",3)=DODX ; Date of Death +1
. S FDA(2.312,DA_","_DA(1)_",",3)=DOD ; Date of Death
. D FILE^DIE("","FDA")
. L -^DPT(DFN,.312,IBIEN)
;IB*732/DTG - end DODX should be the Date of Death (DOD), removing DODX
;
; IB*2.0*579 - added if statement below
; If any policies were expired and the Covered by Health Insurance flag is set to 'Y'.
; change it to 'N'
I DEACT D
. S HCOV=$$GET1^DIQ(2,DFN_",",.3192,"I")
. Q:HCOV'="Y" ; Already set to 'N'
. N IBSUPRES
. S IBSUPRES=1
. D COVERED^IBCNSM31(DFN,HCOV) ; Set the Health Coverage flag to 'N'
Q
;
GETPER(SECKEY,XMY) ;EP
; IB*2.0*549 Added method
; Returns a list of users with the specified security key
; Input: SECKEY - Security key to search for
; Output: XMY() - Array email addresses for users who have the specified key
N XUSIEN,X
S XUSIEN=0
F S XUSIEN=$O(^XUSEC(SECKEY,XUSIEN)) Q:'XUSIEN D
. ;
. ; Don't return TERMINATED or DISUSERed users
. S X=$$ACTIVE^XUSER(XUSIEN)
. I X=""!($P(X,"^",1)=0) Q
. ;
. ; Put users emails into output array
. S XMY(XUSIEN)=""
Q
;
FTFIC(IBIEN,MDCALL) ;EP
; IB*2.0*549 added function
; Returns Timely Filing Timeframe text for a specified Insurance Company
; translate fields 36,.18 and 36,.19 to agreed upon displayed text for
; Insurance company Reports
; Input: IBIEN - IEN of the insurance company to get data from
; MDCALL - 1 if being called from the Missing Data Report
; 0 otherwise. Optional, defaults to 0
; Returns: Timely Filing Timeframe text for the specified Insurance Company
; NOTE: If MDCALL=1 null Standard FTF Values and Qualifiers are
; as '###' instead of null or 'UNKNOWN' respectively
N FTF,FTFV
S:'$D(MDCALL) MDCALL=0
Q:'$D(IBIEN) ""
S FTF=$$GET1^DIQ(36,IBIEN_",",.18,"I") ; Standard FTF IEN (file 355.13)
S FTFV=$$GET1^DIQ(36,IBIEN_",",.19,"I") ; Standard FTF Value
Q $$FTFMAP(FTF,FTFV,MDCALL)
;
FTFGP(GIEN,MDCALL) ;EP
; IB*2.0*549 added function
; Returns Timely Filing Timeframe text for a specified Group Insurance Plan
; translate fields 355.3,.16 and 355.3,.17 to agreed upon displayed text for
; Insurance company Reports
; Input: GIEN - IEN of the group insurance plan to get data from
; MDCALL - 1 if being called from the Missing Data Report
; 0 otherwise. Optional, defaults to 0
; Returns: Timely Filing Timeframe text for the specified Group Insurance Plan
; NOTE: If MDCALL=1 null Standard FTF Values and Qualifiers are
; as '###' instead of null or 'UNKNOWN' respectively
N FTF,FTFV,XX,ZZ
S:'$D(MDCALL) MDCALL=0
Q:'$D(GIEN) ""
S FTF=$$GET1^DIQ(355.3,GIEN_",",.16,"I") ; Standard FTF IEN (file 355.13)
S FTFV=$$GET1^DIQ(355.3,GIEN_",",.17,"I") ; Standard FTF Value
Q $$FTFMAP(FTF,FTFV,MDCALL)
;
FTFMAP(FIEN,FTFV,MDCALL) ; Returns Timely Filing Text for the specified Standard FTF
; and Standard FTF Value
;IB*2.0*549 added function
; Input: FIEN - IEN of the Standard FTF (filer 355.13)
; MDCALL - 1 if being called from the Missing Data Report
; 0 otherwise. Optional, defaults to 0
; Output: FTFV - Standard FTF Value
; Returns: Timely Filing Timeframe text
N FTF
S:'$D(MDCALL) MDCALL=0
I MDCALL,FTFV="" S FTFV="###"
S FTF=$$GET1^DIQ(355.13,FIEN_",",.01) ; Standard FTF name
Q:FTF="" FTFV_" ("_$S(MDCALL:"###",1:"UNKNOWN")_")"
Q:FTF="DAYS" FTFV_" (DYS)"
Q:FTF="DAYS OF FOLLOWING YEAR" FTFV_" (DYS OF NEXT YR)"
Q:FTF="DAYS PLUS ONE YEAR" FTFV_" (DYS_1 YR)"
Q:FTF="END OF FOLLOWING YEAR" FTFV_" (END OF NEXT YR)"
Q:FTF="MONTH(S)" FTFV_" (MOS)"
Q:FTF="MONTHS OF FOLLOWING YEAR" FTFV_" (MOS OF NEXT YR)"
Q:FTF="NO FILING TIME FRAME LIMIT" FTFV_" (N/A)"
Q:FTF="YEAR(S)" FTFV_" (YRS)"
Q FTFV_" ("_$S(MDCALL:"###",1:"UNKNOWN")_")"
;
RSTA(REC) ; Update status in Response File from Transmission Queue to
; Communication Timeout
; Input Parameters
; REC = IEN from TQ file
; -- Removed 10/29/02 --WCH = Which Record 'P'=Previous, 'C'=Current
; -- if no Which Record passed, it will assume the current one
;
N HIEN,RIEN
S HIEN=0
; Loop thru HL7 messages associated with the IIV Inquiry
F S HIEN=$O(^IBCN(365.1,REC,2,HIEN)) Q:'HIEN D
. ; Determine IIV Response associated with the HL7 message
. S RIEN=$P($G(^IBCN(365.1,REC,2,HIEN,0)),U,3) Q:'RIEN
. ; If IIV Response status is 'Response Received', don't update it
. I $P($G(^IBCN(365,RIEN,0)),U,6)=3 Q
. ; Update IIV Response status to 'Communication Timeout'
. D RSP^IBCNEUT2(RIEN,5)
. Q
;
Q
;
TXT(TXT) ;Parse text for wrapping
; Input Parameter
; TXT = The array name
;
I '$D(@(TXT)) Q
;
K ^UTILITY($J,"W")
;
; Define length of text string; left is 1 and right is 78
S DIWF="",DIWL=1,DIWR=78
;
; Format text into scratch file
S CT=0
F S CT=$O(@(TXT)@(CT)) Q:'CT D
. S X=@TXT@(CT) D ^DIWP
;
K @(TXT)
;
; Reset formatted text back to array
S CT=0
F S CT=$O(^UTILITY($J,"W",1,CT)) Q:'CT D
. S @(TXT)@(CT)=^UTILITY($J,"W",1,CT,0)
;
K ^UTILITY($J,"W"),CT,DIWF,DIWL,DIWR,X,Z,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I
Q
;
ERRN(ARRAY) ; Get the next FileMan error number from the array
; Input
; ARRAY = the array name, include "DIERR"
; Output
; IBEY = the next error number
;
; Example call
; S IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
;
NEW IBEY
;
I '$D(@(ARRAY)) S @(ARRAY)=1 Q 1
;
S IBEY=$P(@(ARRAY),U,1)
S IBEY=IBEY+1,$P(@(ARRAY),U,1)=IBEY
Q IBEY
;
MBICHK(BUFFIEN) ; See if the buffer entry is an MBI request
; return 1 if the provided buffer is an MBI request; otherwise, 0
N IBINSNM
S IBINSNM=$$GET1^DIQ(355.33,BUFFIEN_",","INSURANCE COMPANY NAME")
I IBINSNM="" Q 0
Q +($$GET1^DIQ(350.9,"1,","MBI PAYER")=IBINSNM)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEUT7 9657 printed Nov 24, 2022@14:04:07 Page 2
IBCNEUT7 ;DAOU/ALA - IIV MISC. UTILITIES ;14-OCT-2015
+1 ;;2.0;INTEGRATED BILLING;**184,549,579,582,601,732**;21-MAR-94;Build 13
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;**Program Description**
+5 ; This program contains some general utilities or functions
+6 ; IB*2*601/DM XMITOK() Gate-keeper routine moved to IBCNETST
+7 ;
+8 QUIT
+9 ;
DEATH(DFN,DOD) ;EP
+1 ; IB*2.0*549 added method
+2 ;IB*2.0*732/DTG start cleaned up and added comment
+3 ; Sets the INSURANCE EXPIRATION DATE (file 2.312, field 3) for all active
+4 ; insurances of the selected patient to be the date of death
+5 ;
+6 ; NOTE: this tag is called by a trigger on the DATE OF DEATH (file 2, field .351)
+7 ;IB*2.0*732/DTG end cleaned up and added comment
+8 ;
+9 ; Input: DFN - IEN of the patient to term insurances for
+10 ; DOD - Internal date of death (file 2, field .351) of the patient
+11 NEW MTIME,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+12 ; Fileman date/time
SET MTIME=$$NOW^XLFDT()
+13 ; Convert to $H format
SET ZTDTH=$$FMTH^XLFDT(MTIME)
+14 ;
+15 ; Set up the other TaskManager variables
+16 SET ZTRTN="DEATH2^IBCNEUT7"
+17 SET ZTDESC="eIV Auto Termination of Policies for deceased patients"
+18 SET ZTIO=""
+19 SET ZTSAVE("DFN")=""
SET ZTSAVE("DOD")=""
+20 ; Call TaskManager
DO ^%ZTLOAD
+21 QUIT
+22 ;
DEATH2 ;EP from TaskMan
+1 ; IB*2.0*549 added method
+2 ;IB*732/DTG - start cleaned up and added comment
+3 ; NOTE: This tag is called by DEATH^IBCNEUT7
+4 ;
+5 ; Sets the INSURANCE EXPIRATION DATE (file 2.312, field 3) for all active
+6 ; insurances of the selected patient to be the date of death
+7 ;IB*732/DTG - end cleaned up and added comment
+8 ;
+9 ; IB*2.0*579 - Also sets the 'COVERED BY HEALTH INSURANCE' to 'N' (file 2, field .3192)
+10 ; if it's not already set to 'N'
+11 ; Input: DFN - IEN of the patient to term insurances for
+12 ; DOD - Internal date of death (file 2, field .351) of the patient
+13 ;IB*732/DTG - start DODX should be the Date of Death (DOD), removing DODX
+14 ;N EXPDT,DA,DEACT,DODX,FDA,HCOV,IBIEN ; IB*2.0*579 - added DEACT,HCOV
+15 ; IB*2.0*579 - added DEACT,HCOV
NEW EXPDT,DA,DEACT,FDA,HCOV,IBIEN
+16 ; IB*2.0*579 - added line
SET DEACT=0
+17 ;S DODX=$P($$FMADD^XLFDT(DOD,1),".",1) ; Date of Death +1
+18 SET IBIEN=0
+19 FOR
SET IBIEN=$ORDER(^DPT(DFN,.312,IBIEN))
if +IBIEN=0
QUIT
Begin DoDot:1
+20 ;S EXPDT=$$GET1^DIQ(2.312,IBIEN_","_DFN_",",3,"I") ; Policy Expiration Date
+21 ; Insurance Expiration Date
SET EXPDT=$$GET1^DIQ(2.312,IBIEN_","_DFN_",",3,"I")
+22 ; Policy has an expiration date
if EXPDT'=""
QUIT
+23 LOCK +^DPT(DFN,.312,IBIEN):5
+24 ; Send email IB SUPERVISOR users
IF '$TEST
Begin DoDot:2
+25 NEW EDT,MLGRP,MSG,PNM,SSN,SUBJECT,XMY
+26 SET SUBJECT="eIV: Policy Expiration for deceased patient"
+27 SET MLGRP=$$MGRP^IBCNEUT5
+28 SET PNM=$$GET1^DIQ(2,DFN,.01)
+29 ;S EDT=$$FMTE^XLFDT(DODX,"2DZ")
+30 SET EDT=$$FMTE^XLFDT(DOD,"2DZ")
+31 SET SSN=$$GET1^DIQ(2,DFN,.09)
SET SSN=$EXTRACT(SSN,6,9)
+32 SET MSG(1)=PNM_" "_SSN_" was just marked as deceased. Action Needed:"
+33 SET MSG(2)=" Update the patient's active policies and enter and expiration date of "_EDT_"."
+34 DO GETPER("IB SUPERVISOR",.XMY)
+35 DO MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
End DoDot:2
QUIT
+36 ;
+37 ; Set Policy expiration date to be date of death
+38 ; IB*2.0*579 - added line
SET DEACT=1
+39 KILL DA,FDA
+40 SET DA=IBIEN
SET DA(1)=DFN
+41 ; Date Last Edited
SET FDA(2.312,DA_","_DA(1)_",",1.05)=$$NOW^XLFDT()
+42 ; Last Edited By
SET FDA(2.312,DA_","_DA(1)_",",1.06)=.5
+43 ;S FDA(2.312,DA_","_DA(1)_",",3)=DODX ; Date of Death +1
+44 ; Date of Death
SET FDA(2.312,DA_","_DA(1)_",",3)=DOD
+45 DO FILE^DIE("","FDA")
+46 LOCK -^DPT(DFN,.312,IBIEN)
End DoDot:1
+47 ;IB*732/DTG - end DODX should be the Date of Death (DOD), removing DODX
+48 ;
+49 ; IB*2.0*579 - added if statement below
+50 ; If any policies were expired and the Covered by Health Insurance flag is set to 'Y'.
+51 ; change it to 'N'
+52 IF DEACT
Begin DoDot:1
+53 SET HCOV=$$GET1^DIQ(2,DFN_",",.3192,"I")
+54 ; Already set to 'N'
if HCOV'="Y"
QUIT
+55 NEW IBSUPRES
+56 SET IBSUPRES=1
+57 ; Set the Health Coverage flag to 'N'
DO COVERED^IBCNSM31(DFN,HCOV)
End DoDot:1
+58 QUIT
+59 ;
GETPER(SECKEY,XMY) ;EP
+1 ; IB*2.0*549 Added method
+2 ; Returns a list of users with the specified security key
+3 ; Input: SECKEY - Security key to search for
+4 ; Output: XMY() - Array email addresses for users who have the specified key
+5 NEW XUSIEN,X
+6 SET XUSIEN=0
+7 FOR
SET XUSIEN=$ORDER(^XUSEC(SECKEY,XUSIEN))
if 'XUSIEN
QUIT
Begin DoDot:1
+8 ;
+9 ; Don't return TERMINATED or DISUSERed users
+10 SET X=$$ACTIVE^XUSER(XUSIEN)
+11 IF X=""!($PIECE(X,"^",1)=0)
QUIT
+12 ;
+13 ; Put users emails into output array
+14 SET XMY(XUSIEN)=""
End DoDot:1
+15 QUIT
+16 ;
FTFIC(IBIEN,MDCALL) ;EP
+1 ; IB*2.0*549 added function
+2 ; Returns Timely Filing Timeframe text for a specified Insurance Company
+3 ; translate fields 36,.18 and 36,.19 to agreed upon displayed text for
+4 ; Insurance company Reports
+5 ; Input: IBIEN - IEN of the insurance company to get data from
+6 ; MDCALL - 1 if being called from the Missing Data Report
+7 ; 0 otherwise. Optional, defaults to 0
+8 ; Returns: Timely Filing Timeframe text for the specified Insurance Company
+9 ; NOTE: If MDCALL=1 null Standard FTF Values and Qualifiers are
+10 ; as '###' instead of null or 'UNKNOWN' respectively
+11 NEW FTF,FTFV
+12 if '$DATA(MDCALL)
SET MDCALL=0
+13 if '$DATA(IBIEN)
QUIT ""
+14 ; Standard FTF IEN (file 355.13)
SET FTF=$$GET1^DIQ(36,IBIEN_",",.18,"I")
+15 ; Standard FTF Value
SET FTFV=$$GET1^DIQ(36,IBIEN_",",.19,"I")
+16 QUIT $$FTFMAP(FTF,FTFV,MDCALL)
+17 ;
FTFGP(GIEN,MDCALL) ;EP
+1 ; IB*2.0*549 added function
+2 ; Returns Timely Filing Timeframe text for a specified Group Insurance Plan
+3 ; translate fields 355.3,.16 and 355.3,.17 to agreed upon displayed text for
+4 ; Insurance company Reports
+5 ; Input: GIEN - IEN of the group insurance plan to get data from
+6 ; MDCALL - 1 if being called from the Missing Data Report
+7 ; 0 otherwise. Optional, defaults to 0
+8 ; Returns: Timely Filing Timeframe text for the specified Group Insurance Plan
+9 ; NOTE: If MDCALL=1 null Standard FTF Values and Qualifiers are
+10 ; as '###' instead of null or 'UNKNOWN' respectively
+11 NEW FTF,FTFV,XX,ZZ
+12 if '$DATA(MDCALL)
SET MDCALL=0
+13 if '$DATA(GIEN)
QUIT ""
+14 ; Standard FTF IEN (file 355.13)
SET FTF=$$GET1^DIQ(355.3,GIEN_",",.16,"I")
+15 ; Standard FTF Value
SET FTFV=$$GET1^DIQ(355.3,GIEN_",",.17,"I")
+16 QUIT $$FTFMAP(FTF,FTFV,MDCALL)
+17 ;
FTFMAP(FIEN,FTFV,MDCALL) ; Returns Timely Filing Text for the specified Standard FTF
+1 ; and Standard FTF Value
+2 ;IB*2.0*549 added function
+3 ; Input: FIEN - IEN of the Standard FTF (filer 355.13)
+4 ; MDCALL - 1 if being called from the Missing Data Report
+5 ; 0 otherwise. Optional, defaults to 0
+6 ; Output: FTFV - Standard FTF Value
+7 ; Returns: Timely Filing Timeframe text
+8 NEW FTF
+9 if '$DATA(MDCALL)
SET MDCALL=0
+10 IF MDCALL
IF FTFV=""
SET FTFV="###"
+11 ; Standard FTF name
SET FTF=$$GET1^DIQ(355.13,FIEN_",",.01)
+12 if FTF=""
QUIT FTFV_" ("_$SELECT(MDCALL:"###",1:"UNKNOWN")_")"
+13 if FTF="DAYS"
QUIT FTFV_" (DYS)"
+14 if FTF="DAYS OF FOLLOWING YEAR"
QUIT FTFV_" (DYS OF NEXT YR)"
+15 if FTF="DAYS PLUS ONE YEAR"
QUIT FTFV_" (DYS_1 YR)"
+16 if FTF="END OF FOLLOWING YEAR"
QUIT FTFV_" (END OF NEXT YR)"
+17 if FTF="MONTH(S)"
QUIT FTFV_" (MOS)"
+18 if FTF="MONTHS OF FOLLOWING YEAR"
QUIT FTFV_" (MOS OF NEXT YR)"
+19 if FTF="NO FILING TIME FRAME LIMIT"
QUIT FTFV_" (N/A)"
+20 if FTF="YEAR(S)"
QUIT FTFV_" (YRS)"
+21 QUIT FTFV_" ("_$SELECT(MDCALL:"###",1:"UNKNOWN")_")"
+22 ;
RSTA(REC) ; Update status in Response File from Transmission Queue to
+1 ; Communication Timeout
+2 ; Input Parameters
+3 ; REC = IEN from TQ file
+4 ; -- Removed 10/29/02 --WCH = Which Record 'P'=Previous, 'C'=Current
+5 ; -- if no Which Record passed, it will assume the current one
+6 ;
+7 NEW HIEN,RIEN
+8 SET HIEN=0
+9 ; Loop thru HL7 messages associated with the IIV Inquiry
+10 FOR
SET HIEN=$ORDER(^IBCN(365.1,REC,2,HIEN))
if 'HIEN
QUIT
Begin DoDot:1
+11 ; Determine IIV Response associated with the HL7 message
+12 SET RIEN=$PIECE($GET(^IBCN(365.1,REC,2,HIEN,0)),U,3)
if 'RIEN
QUIT
+13 ; If IIV Response status is 'Response Received', don't update it
+14 IF $PIECE($GET(^IBCN(365,RIEN,0)),U,6)=3
QUIT
+15 ; Update IIV Response status to 'Communication Timeout'
+16 DO RSP^IBCNEUT2(RIEN,5)
+17 QUIT
End DoDot:1
+18 ;
+19 QUIT
+20 ;
TXT(TXT) ;Parse text for wrapping
+1 ; Input Parameter
+2 ; TXT = The array name
+3 ;
+4 IF '$DATA(@(TXT))
QUIT
+5 ;
+6 KILL ^UTILITY($JOB,"W")
+7 ;
+8 ; Define length of text string; left is 1 and right is 78
+9 SET DIWF=""
SET DIWL=1
SET DIWR=78
+10 ;
+11 ; Format text into scratch file
+12 SET CT=0
+13 FOR
SET CT=$ORDER(@(TXT)@(CT))
if 'CT
QUIT
Begin DoDot:1
+14 SET X=@TXT@(CT)
DO ^DIWP
End DoDot:1
+15 ;
+16 KILL @(TXT)
+17 ;
+18 ; Reset formatted text back to array
+19 SET CT=0
+20 FOR
SET CT=$ORDER(^UTILITY($JOB,"W",1,CT))
if 'CT
QUIT
Begin DoDot:1
+21 SET @(TXT)@(CT)=^UTILITY($JOB,"W",1,CT,0)
End DoDot:1
+22 ;
+23 KILL ^UTILITY($JOB,"W"),CT,DIWF,DIWL,DIWR,X,Z,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I
+24 QUIT
+25 ;
ERRN(ARRAY) ; Get the next FileMan error number from the array
+1 ; Input
+2 ; ARRAY = the array name, include "DIERR"
+3 ; Output
+4 ; IBEY = the next error number
+5 ;
+6 ; Example call
+7 ; S IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
+8 ;
+9 NEW IBEY
+10 ;
+11 IF '$DATA(@(ARRAY))
SET @(ARRAY)=1
QUIT 1
+12 ;
+13 SET IBEY=$PIECE(@(ARRAY),U,1)
+14 SET IBEY=IBEY+1
SET $PIECE(@(ARRAY),U,1)=IBEY
+15 QUIT IBEY
+16 ;
MBICHK(BUFFIEN) ; See if the buffer entry is an MBI request
+1 ; return 1 if the provided buffer is an MBI request; otherwise, 0
+2 NEW IBINSNM
+3 SET IBINSNM=$$GET1^DIQ(355.33,BUFFIEN_",","INSURANCE COMPANY NAME")
+4 IF IBINSNM=""
QUIT 0
+5 QUIT +($$GET1^DIQ(350.9,"1,","MBI PAYER")=IBINSNM)
