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

IBCNEUT7.m

Go to the documentation of this file.
  1. IBCNEUT7 ;DAOU/ALA - IIV MISC. UTILITIES ;14-OCT-2015
  1. ;;2.0;INTEGRATED BILLING;**184,549,579,582,601,732,743**;21-MAR-94;Build 18
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;**Program Description**
  1. ; This program contains some general utilities or functions
  1. ; IB*2*601/DM XMITOK() Gate-keeper routine moved to IBCNETST
  1. ;
  1. Q
  1. ;
  1. DEATH(DFN,DOD) ;EP
  1. ; IB*2.0*549 added method
  1. ;IB*2.0*732/DTG start cleaned up and added comment
  1. ; Sets the INSURANCE EXPIRATION DATE (file 2.312, field 3) for all active
  1. ; insurances of the selected patient to be the date of death
  1. ;
  1. ; NOTE: this tag is called by a trigger on the DATE OF DEATH (file 2, field .351)
  1. ;IB*2.0*732/DTG end cleaned up and added comment
  1. ;
  1. ; Input: DFN - IEN of the patient to term insurances for
  1. ; DOD - Internal date of death (file 2, field .351) of the patient
  1. N MTIME,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
  1. S MTIME=$$NOW^XLFDT() ; Fileman date/time
  1. S ZTDTH=$$FMTH^XLFDT(MTIME) ; Convert to $H format
  1. ;
  1. ; Set up the other TaskManager variables
  1. S ZTRTN="DEATH2^IBCNEUT7"
  1. S ZTDESC="eIV Auto Termination of Policies for deceased patients"
  1. S ZTIO=""
  1. S ZTSAVE("DFN")="",ZTSAVE("DOD")=""
  1. D ^%ZTLOAD ; Call TaskManager
  1. Q
  1. ;
  1. DEATH2 ;EP from TaskMan
  1. ; IB*2.0*549 added method
  1. ;IB*732/DTG - start cleaned up and added comment
  1. ; NOTE: This tag is called by DEATH^IBCNEUT7
  1. ;
  1. ; Sets the INSURANCE EXPIRATION DATE (file 2.312, field 3) for all active
  1. ; insurances of the selected patient to be the date of death
  1. ;IB*732/DTG - end cleaned up and added comment
  1. ;
  1. ; IB*2.0*579 - Also sets the 'COVERED BY HEALTH INSURANCE' to 'N' (file 2, field .3192)
  1. ; if it's not already set to 'N'
  1. ; Input: DFN - IEN of the patient to term insurances for
  1. ; DOD - Internal date of death (file 2, field .351) of the patient
  1. ;IB*732/DTG - start DODX should be the Date of Death (DOD), removing DODX
  1. ;N EXPDT,DA,DEACT,DODX,FDA,HCOV,IBIEN ; IB*2.0*579 - added DEACT,HCOV
  1. N EXPDT,DA,DEACT,FDA,HCOV,IBIEN ; IB*2.0*579 - added DEACT,HCOV
  1. S DEACT=0 ; IB*2.0*579 - added line
  1. ;S DODX=$P($$FMADD^XLFDT(DOD,1),".",1) ; Date of Death +1
  1. S IBIEN=0
  1. F S IBIEN=$O(^DPT(DFN,.312,IBIEN)) Q:+IBIEN=0 D
  1. . ;S EXPDT=$$GET1^DIQ(2.312,IBIEN_","_DFN_",",3,"I") ; Policy Expiration Date
  1. . S EXPDT=$$GET1^DIQ(2.312,IBIEN_","_DFN_",",3,"I") ; Insurance Expiration Date
  1. . Q:EXPDT'="" ; Policy has an expiration date
  1. . L +^DPT(DFN,.312,IBIEN):5
  1. . I '$T D Q ; Send email IB SUPERVISOR users
  1. . . N EDT,MLGRP,MSG,PNM,SSN,SUBJECT,XMY
  1. . . S SUBJECT="eIV: Policy Expiration for deceased patient"
  1. . . S MLGRP=$$MGRP^IBCNEUT5
  1. . . S PNM=$$GET1^DIQ(2,DFN,.01)
  1. . . ;S EDT=$$FMTE^XLFDT(DODX,"2DZ")
  1. . . S EDT=$$FMTE^XLFDT(DOD,"2DZ")
  1. . . S SSN=$$GET1^DIQ(2,DFN,.09),SSN=$E(SSN,6,9)
  1. . . S MSG(1)=PNM_" "_SSN_" was just marked as deceased. Action Needed:"
  1. . . S MSG(2)=" Update the patient's active policies and enter and expiration date of "_EDT_"."
  1. . . D GETPER("IB SUPERVISOR",.XMY)
  1. . . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
  1. . ;
  1. . ; Set Policy expiration date to be date of death
  1. . S DEACT=1 ; IB*2.0*579 - added line
  1. . K DA,FDA
  1. . S DA=IBIEN,DA(1)=DFN
  1. . S FDA(2.312,DA_","_DA(1)_",",1.05)=$$NOW^XLFDT() ; Date Last Edited
  1. . S FDA(2.312,DA_","_DA(1)_",",1.06)=.5 ; Last Edited By
  1. . ;S FDA(2.312,DA_","_DA(1)_",",3)=DODX ; Date of Death +1
  1. . S FDA(2.312,DA_","_DA(1)_",",3)=DOD ; Date of Death
  1. . D FILE^DIE("","FDA")
  1. . L -^DPT(DFN,.312,IBIEN)
  1. ;IB*732/DTG - end DODX should be the Date of Death (DOD), removing DODX
  1. ;
  1. ; IB*2.0*579 - added if statement below
  1. ; If any policies were expired and the Covered by Health Insurance flag is set to 'Y'.
  1. ; change it to 'N'
  1. I DEACT D
  1. . S HCOV=$$GET1^DIQ(2,DFN_",",.3192,"I")
  1. . Q:HCOV'="Y" ; Already set to 'N'
  1. . N IBSUPRES
  1. . S IBSUPRES=1
  1. . D COVERED^IBCNSM31(DFN,HCOV) ; Set the Health Coverage flag to 'N'
  1. Q
  1. ;
  1. GETPER(SECKEY,XMY) ;EP
  1. ; IB*2.0*549 Added method
  1. ; Returns a list of users with the specified security key
  1. ; Input: SECKEY - Security key to search for
  1. ; Output: XMY() - Array email addresses for users who have the specified key
  1. N XUSIEN,X
  1. S XUSIEN=0
  1. F S XUSIEN=$O(^XUSEC(SECKEY,XUSIEN)) Q:'XUSIEN D
  1. . ;
  1. . ; Don't return TERMINATED or DISUSERed users
  1. . S X=$$ACTIVE^XUSER(XUSIEN)
  1. . I X=""!($P(X,"^",1)=0) Q
  1. . ;
  1. . ; Put users emails into output array
  1. . S XMY(XUSIEN)=""
  1. Q
  1. ;
  1. FTFIC(IBIEN,MDCALL) ;EP
  1. ; IB*2.0*549 added function
  1. ; Returns Timely Filing Timeframe text for a specified Insurance Company
  1. ; translate fields 36,.18 and 36,.19 to agreed upon displayed text for
  1. ; Insurance company Reports
  1. ; Input: IBIEN - IEN of the insurance company to get data from
  1. ; MDCALL - 1 if being called from the Missing Data Report
  1. ; 0 otherwise. Optional, defaults to 0
  1. ; Returns: Timely Filing Timeframe text for the specified Insurance Company
  1. ; NOTE: If MDCALL=1 null Standard FTF Values and Qualifiers are
  1. ; as '###' instead of null or 'UNKNOWN' respectively
  1. N FTF,FTFV
  1. S:'$D(MDCALL) MDCALL=0
  1. Q:'$D(IBIEN) ""
  1. S FTF=$$GET1^DIQ(36,IBIEN_",",.18,"I") ; Standard FTF IEN (file 355.13)
  1. S FTFV=$$GET1^DIQ(36,IBIEN_",",.19,"I") ; Standard FTF Value
  1. Q $$FTFMAP(FTF,FTFV,MDCALL)
  1. ;
  1. FTFGP(GIEN,MDCALL) ;EP
  1. ; IB*2.0*549 added function
  1. ; Returns Timely Filing Timeframe text for a specified Group Insurance Plan
  1. ; translate fields 355.3,.16 and 355.3,.17 to agreed upon displayed text for
  1. ; Insurance company Reports
  1. ; Input: GIEN - IEN of the group insurance plan to get data from
  1. ; MDCALL - 1 if being called from the Missing Data Report
  1. ; 0 otherwise. Optional, defaults to 0
  1. ; Returns: Timely Filing Timeframe text for the specified Group Insurance Plan
  1. ; NOTE: If MDCALL=1 null Standard FTF Values and Qualifiers are
  1. ; as '###' instead of null or 'UNKNOWN' respectively
  1. N FTF,FTFV,XX,ZZ
  1. S:'$D(MDCALL) MDCALL=0
  1. Q:'$D(GIEN) ""
  1. S FTF=$$GET1^DIQ(355.3,GIEN_",",.16,"I") ; Standard FTF IEN (file 355.13)
  1. S FTFV=$$GET1^DIQ(355.3,GIEN_",",.17,"I") ; Standard FTF Value
  1. Q $$FTFMAP(FTF,FTFV,MDCALL)
  1. ;
  1. FTFMAP(FIEN,FTFV,MDCALL) ; Returns Timely Filing Text for the specified Standard FTF
  1. ; and Standard FTF Value
  1. ;IB*2.0*549 added function
  1. ; Input: FIEN - IEN of the Standard FTF (filer 355.13)
  1. ; MDCALL - 1 if being called from the Missing Data Report
  1. ; 0 otherwise. Optional, defaults to 0
  1. ; Output: FTFV - Standard FTF Value
  1. ; Returns: Timely Filing Timeframe text
  1. N FTF
  1. S:'$D(MDCALL) MDCALL=0
  1. I MDCALL,FTFV="" S FTFV="###"
  1. S FTF=$$GET1^DIQ(355.13,FIEN_",",.01) ; Standard FTF name
  1. Q:FTF="" FTFV_" ("_$S(MDCALL:"###",1:"UNKNOWN")_")"
  1. Q:FTF="DAYS" FTFV_" (DYS)"
  1. Q:FTF="DAYS OF FOLLOWING YEAR" FTFV_" (DYS OF NEXT YR)"
  1. Q:FTF="DAYS PLUS ONE YEAR" FTFV_" (DYS_1 YR)"
  1. Q:FTF="END OF FOLLOWING YEAR" FTFV_" (END OF NEXT YR)"
  1. Q:FTF="MONTH(S)" FTFV_" (MOS)"
  1. Q:FTF="MONTHS OF FOLLOWING YEAR" FTFV_" (MOS OF NEXT YR)"
  1. Q:FTF="NO FILING TIME FRAME LIMIT" FTFV_" (N/A)"
  1. Q:FTF="YEAR(S)" FTFV_" (YRS)"
  1. Q FTFV_" ("_$S(MDCALL:"###",1:"UNKNOWN")_")"
  1. ;
  1. RSTA(REC) ; Update status in Response File from Transmission Queue to
  1. ; Communication Timeout
  1. ; Input Parameters
  1. ; REC = IEN from TQ file
  1. ; -- Removed 10/29/02 --WCH = Which Record 'P'=Previous, 'C'=Current
  1. ; -- if no Which Record passed, it will assume the current one
  1. ;
  1. N HIEN,RIEN
  1. S HIEN=0
  1. ; Loop thru HL7 messages associated with the IIV Inquiry
  1. F S HIEN=$O(^IBCN(365.1,REC,2,HIEN)) Q:'HIEN D
  1. . ; Determine IIV Response associated with the HL7 message
  1. . S RIEN=$P($G(^IBCN(365.1,REC,2,HIEN,0)),U,3) Q:'RIEN
  1. . ; If IIV Response status is 'Response Received', don't update it
  1. . I $P($G(^IBCN(365,RIEN,0)),U,6)=3 Q
  1. . ; Update IIV Response status to 'Communication Timeout'
  1. . D RSP^IBCNEUT2(RIEN,5)
  1. . Q
  1. ;
  1. Q
  1. ;
  1. TXT(TXT) ;Parse text for wrapping
  1. ; Input Parameter
  1. ; TXT = The array name
  1. ;
  1. I '$D(@(TXT)) Q
  1. ;
  1. K ^UTILITY($J,"W")
  1. ;
  1. ; Define length of text string; left is 1 and right is 78
  1. S DIWF="",DIWL=1,DIWR=78
  1. ;
  1. ; Format text into scratch file
  1. S CT=0
  1. F S CT=$O(@(TXT)@(CT)) Q:'CT D
  1. . S X=@TXT@(CT) D ^DIWP
  1. ;
  1. K @(TXT)
  1. ;
  1. ; Reset formatted text back to array
  1. S CT=0
  1. F S CT=$O(^UTILITY($J,"W",1,CT)) Q:'CT D
  1. . S @(TXT)@(CT)=^UTILITY($J,"W",1,CT,0)
  1. ;
  1. K ^UTILITY($J,"W"),CT,DIWF,DIWL,DIWR,X,Z,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I
  1. Q
  1. ;
  1. ERRN(ARRAY) ; Get the next FileMan error number from the array
  1. ; Input
  1. ; ARRAY = the array name, include "DIERR"
  1. ; Output
  1. ; IBEY = the next error number
  1. ;
  1. ; Example call
  1. ; S IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
  1. ;
  1. NEW IBEY
  1. ;
  1. I '$D(@(ARRAY)) S @(ARRAY)=1 Q 1
  1. ;
  1. S IBEY=$P(@(ARRAY),U,1)
  1. S IBEY=IBEY+1,$P(@(ARRAY),U,1)=IBEY
  1. Q IBEY
  1. ;
  1. MBICHK(BUFFIEN) ; See if the buffer entry is an MBI request
  1. ; return 1 if the provided buffer is an MBI request; otherwise, 0
  1. N IBINSNM
  1. S IBINSNM=$$GET1^DIQ(355.33,BUFFIEN_",","INSURANCE COMPANY NAME")
  1. I IBINSNM="" Q 0
  1. Q +($$GET1^DIQ(350.9,"1,","MBI PAYER")=IBINSNM)
  1. ;
  1. ;IB*743/DTG adding a check for orphans in IIV TRANSMISSION QUEUE File (#365.1)
  1. BGORPHAN() ; entry point to task a job to find TQ Orphans
  1. ;
  1. N DIC,DIR,GTASKS,IBI,IBDATE,IBDIR,IBMES,IBPROD,IBRET,IBSITE,IBSITENAM,RMSG,TSK,X,Y
  1. N ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTQUEUED,ZTREQ,ZTSK
  1. S IBPROD=$$PROD^XUPROD(1)
  1. S IBDATE=$$FMTE^XLFDT(DT,5)
  1. S IBSITE=$$SITE^VASITE ; Get the site name & #
  1. S IBSITENAM=$P(IBSITE,U,2),IBSITE=$P(IBSITE,U,3) ; piece 3 is the site #
  1. S IBDIR="IB - eIV TQ Orphan Check"
  1. S IBRET=""
  1. I 'IBPROD Q "-1^"_IBDIR_" cannot run since this site is not a Production Account."
  1. ; Check to see if the task is already running.
  1. K GTASKS
  1. D DESC^%ZTLOAD(IBDIR,"GTASKS")
  1. S TSK="",RMSG(0)=0
  1. S TSK=$O(GTASKS(TSK))
  1. I TSK Q "-1^"_IBDIR_" Task "_TSK_" has Already Been Submitted to TASKMAN."
  1. ; build task out array and task off
  1. S ZTRTN="ORPHAN^IBCNEUT7",ZTDESC=IBDIR,ZTIO=""
  1. ; ZTDTH = TODAY AT 8:00 PM
  1. S ZTDTH=$P($$NOW^XLFDT(),"."),ZTDTH=$$FMADD^XLFDT(ZTDTH,,20)
  1. F IBI="IBDATE","IBSITE","IBSITENAM","IBPROD","IBDIR" S ZTSAVE(IBI)=""
  1. K IO("Q"),ZTSK
  1. D ^%ZTLOAD
  1. S IBRET="" S:$D(ZTSK) IBRET=ZTSK
  1. D HOME^%ZIS
  1. ;
  1. I +IBRET S IBMES="1^"_IBDIR_" has been submitted to TASKMAN. Task number: "_(+IBRET)
  1. I 'IBRET D
  1. . S IBER=1
  1. . S IBMES="-1^"_IBDIR_" was NOT successfully submitted to TASKMAN."
  1. . S IBEMSG=$P(IBMES,U,2)
  1. . D ORPHANX ;Send email message that task not successfully submitted.
  1. Q IBMES
  1. ;
  1. ORPHAN ; TASKMAN entry point to check TQ file for orphans
  1. ; This is designed to be tasked through TaskMan.
  1. ; Running directly will not have all the required variables.
  1. ;
  1. N IB36514IEN,IBA,IBARY,IBCNT,IBEDT,IBER,IBFND,IBIDT,IBEMSG,IBNCK,IBND,IBNEWST,IBOK,IBOLDEST,IBTQIEN,IBWDT,IBXMY,MSG,SITE
  1. ;
  1. ;get ien for transmitted from 365.14
  1. S IBEMSG=""
  1. S IBER=0,IB36514IEN=$$FIND1^DIC(365.14,,,"Transmitted")
  1. I 'IB36514IEN S IBER=1 D G ORPHANX
  1. . S IBEMSG="Not able to find 'Transmitted' status record ID in IIV TRANSMISSION STATUS (#365.14) file"
  1. S IBTQIEN=0,IBCNT=0,IBOK=1,IBOLDEST="99999999"
  1. ; get today-29
  1. S IBNEWST="",IBNCK="",IBNCK=$O(^IBCN(365.1,"AC",IB36514IEN,"A"),-1)
  1. I IBNCK D
  1. . S IBNEWST=$$GET1^DIQ(365.1,IBNCK_",",".06","E")
  1. . S IBNEWST=$$FMTE^XLFDT(IBNEWST,5)
  1. S IBWDT=$$FMTH^XLFDT(DT),IBWDT=$P(IBWDT,",",1),IBWDT=IBWDT-29
  1. K IBARY S IBARY=0
  1. F S IBTQIEN=$O(^IBCN(365.1,"AC",IB36514IEN,IBTQIEN)) Q:'IBTQIEN D Q:'IBOK
  1. . ; .01 - Transaction Number, .04 - Transmission Status, .05 - Buffer Entry (from 355.33)
  1. . ; .06 - Date/Time Created, .1 - Which Extract, .11 - Query Flag
  1. . K IBFND,IBND
  1. . D GETS^DIQ(365.1,IBTQIEN_",",".01;.04;.05;.06;.1;.11","IE","IBFND") M IBND=IBFND(365.1,IBTQIEN_",")
  1. . S IBA="",IBEDT=$G(IBND(.06,"E")),IBIDT=$G(IBND(.06,"I"))
  1. . I IBIDT'="" S IBA=$$FMTH^XLFDT(IBIDT),IBA=$P(IBA,",",1)
  1. . I IBA'=""&(IBA<+IBOLDEST) S IBOLDEST=IBA_U_IBEDT
  1. . I IBA>IBWDT S IBOK=0 Q
  1. . S IBARY=IBARY+1,IBARY(IBA)=IBEDT
  1. ;
  1. ORPHANX ; build and send message to eInsurance
  1. S SITE=IBSITENAM_" (#"_IBSITE_")"
  1. ;Send mailman message at completion.
  1. S MSG(1)=IBDIR_" at "_SITE_" in Production"
  1. S MSG(2)=" "
  1. S MSG(3)=" Check of the IIV TRANSMISSION QUEUE File (#365.1) for orphan entries."
  1. S MSG(4)=" "
  1. S MSG(5)=" Run On: "_IBDATE
  1. S MSG(6)=" --------------------------------------------------------------------------"
  1. S MSG(7)=" "
  1. S MSG(8)=" "
  1. I IBER D
  1. . S MSG(9)=IBEMSG
  1. . S MSG(10)="Not able to check the IIV TRANSMISSION QUEUE File (#365.1) for orphan entries."
  1. . S MSG(11)=" ",MSG(12)="",MSG(13)=""
  1. I 'IBER D
  1. .S MSG(9)=" Oldest 'Transmitted' Date: "_$S(IBOLDEST'="99999999":$P(IBOLDEST,U,2),1:"")
  1. .S MSG(10)=" "
  1. .S MSG(11)=" Newest 'Transmitted' Date: "_IBNEWST
  1. .S MSG(12)=""
  1. .S MSG(13)=" Number of 'Transmitted' Status entries 30 days or older: "_(+IBARY)
  1. S MSG(14)=" "
  1. ;
  1. ; Only send to eInsurance Rapid Response if in Production
  1. ; 1=Production Environment, 0=Test Environment
  1. I IBPROD S IBXMY("VHAeInsuranceRapidResponse@domain.ext")=""
  1. D MSG^IBCNEUT5(,SITE_" Check 'TQ' orphan entries","MSG(",,.IBXMY)
  1. ;
  1. ; Tell TaskManager to delete the task's record
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;