IBY579PO ;ALB/FA - IB*2.0*579 POST-INSTALL ;27-OCT-2016
;;2.0;INTEGRATED BILLING;**579**;21-MAR-94;Build 2
;;Per VA Directive 6402, this routine should not be modified.
;
EN ;Entry point
N IBXPD,XPDIDTOT
S XPDIDTOT=1
;
; Update Covered by Health Insurance field (file 2, field .3192) for deceased patients
S IBXPD=1
D HCOV(IBXPD,XPDIDTOT)
D DONE
Q
;
HCOV(IBXPD,XPDIDTOT) ; Update Covered by Health Insurance field for deceased patients
; Input: XBXPD - Post Installation Step
; XPDIDTOT - Total # of Post Installation steps
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Update Covered By Health Insurance field for deceased patients.")
; 1 - For every patient in the patient file check if the patient is deceased field
; (file 2, field .351)
; 2 - Quit if the patient is not deceased
; 3 - Quit if the Covered By Health Insurance field is already set to 'N'
; 3 - Quit if all of the patient's policies are not expired
; 4 - Change the Covered By Health Insurance field to 'N'
; 5 - Add this patient to a list of patients being modified
; 6 - Email the list of patients modified to xxx
;
N MTIME,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
S MTIME=$$NOW^XLFDT() ; Fileman date/time
S MTIME=$$FMADD^XLFDT(MTIME,0,4) ; Set to queue 4 hours later
S ZTDTH=$$FMTH^XLFDT(MTIME) ; Convert to $H format
;
; Set up the other TaskManager variables
S ZTRTN="HCOV2^IBY579PO"
S ZTDESC="IB*2.0*579 Change 'Covered By Health Insurance' field for deceased patients"
S ZTIO=""
D ^%ZTLOAD ; Call TaskManager
Q
;
HCOV2 ;EP
; Called from Task Manager
N CURSIZE,DFN,DOD,EMAIL,EXPDT,HCOV,HCOVN,IIEN,LNCTR,MAXSIZE,MLGRP,MSG,NPAT,NOTEXP
N PNM,SSN,SUBJECT,XMY,XX,YY
K ^TMP($J,"PATLIST"),^TMP($J,"ERRLIST")
S DFN=0
F D Q:'+DFN
. S DFN=$O(^DPT(DFN))
. Q:'+DFN
. S DOD=$$GET1^DIQ(2,DFN_",",.351,"I") ; Date of Death
. Q:DOD="" ; Patient is not Deceased
. S HCOV=$$GET1^DIQ(2,DFN_",",.3192,"I") ; Covered By Health Insurance flag
. Q:HCOV=""!(HCOV="N")!(HCOV="U") ; Covered By Health Insurance already 'N' or "U"
. S IIEN=0,NOTEXP=0
. F D Q:'+IIEN Q:NOTEXP
. . S IIEN=$O(^DPT(DFN,.312,IIEN))
. . Q:'+IIEN
. . S EXPDT=$$GET1^DIQ(2.312,IIEN_","_DFN_",",3,"I") ; Policy Expiration Date
. . Q:EXPDT'="" ; Policy has an expiration date
. . S NOTEXP=1
. Q:NOTEXP ; Not all plans are expired
. D CHGCOV(DFN,HCOV) ; Set the Health Coverage flag to 'N'
. Q:$D(^TMP($J,"ERRLIST",DFN)) ; On error list
. S HCOVN=$$GET1^DIQ(2,DFN_",",.3192,"I") ; New Covered By Health Insurance flag
. Q:HCOVN="Y" ; Deceased patient with coverage, skip
. S ^TMP($J,"PATLIST",DFN)="" ; Add Patient to list
;
I '$D(^TMP($J,"PATLIST")),'$D(^TMP($J,"ERRLIST")) Q ; No patients to update
;
; Get array of users with the 'IB SUPERVISOR' security key
D GETPER^IBCNEUT7("IB SUPERVISOR",.XMY)
;
; Begin email set up
S MAXSIZE=300000,CURSIZE=0,LNCTR=0
S MLGRP=$$MGRP^IBCNEUT5
S SUBJECT="eIV: Change Covered By Health Insurance field for deceased patient - Post Install Task"
;
; First add any patients that had filing errors
I $D(^TMP($J,"ERRLIST")) D
. S LNCTR=LNCTR+1
. S XX(1)="The following patients will need to be manually updated by removing and "
. S XX(2)="re-entering the policy expiration date for one of the patient's policies "
. S XX(3)="so that the 'Covered By Health Insurance' field will be corrected:"
. S YY=$L(XX(1))+$L(XX(2))+$L(XX(3))
. ;
. ; Is the mail message getting too big?
. I (CURSIZE+YY)>MAXSIZE D
. . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
. . K MSG
. . S CURSIZE=0,LNCTR=1
. ;
. S MSG(LNCTR)=XX(1),CURSIZE=CURSIZE+$L(XX(1)),LNCTR=LNCTR+1
. S MSG(LNCTR)=XX(2),CURSIZE=CURSIZE+$L(XX(2)),LNCTR=LNCTR+1
. S MSG(LNCTR)=XX(3),CURSIZE=CURSIZE+$L(XX(3))
. S DFN=""
. F D Q:DFN=""
. . S DFN=$O(^TMP($J,"ERRLIST",DFN))
. . Q:DFN=""
. . S PNM=$$GET1^DIQ(2,DFN,.01)
. . S SSN=$$GET1^DIQ(2,DFN,.09),SSN=$E(SSN,6,9)
. . S NPAT=" "_PNM_" "_SSN
. . ;
. . ; Is the mail message getting too big?
. . I CURSIZE+$L(NPAT)>MAXSIZE D
. . . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
. . . K MSG
. . . S LNCTR=3,MSG(1)=XX(1),MSG(2)=XX(2),MSG(3)=XX(3),CURSIZE=YY
. . S LNCTR=LNCTR+1
. . S MSG(LNCTR)=NPAT
. . S CURSIZE=CURSIZE+$L(NPAT)
. S LNCTR=LNCTR+1,MSG(LNCTR)="",LNCTR=LNCTR+1,MSG(LNCTR)=""
;
; Next add the patients whose Covered By Health Insurance flag was set to 'N'
S LNCTR=LNCTR+1
S MSG(LNCTR)="The 'Covered By Health Insurance' field for the following deceased"
S CURSIZE=CURSIZE+$L(MSG(LNCTR))
S LNCTR=LNCTR+1
S MSG(LNCTR)="patients was automatically set to 'NO':"
S CURSIZE=CURSIZE+$L(MSG(LNCTR))
S DFN=""
F D Q:DFN=""
. S DFN=$O(^TMP($J,"PATLIST",DFN))
. Q:DFN=""
. S PNM=$$GET1^DIQ(2,DFN,.01)
. S SSN=$$GET1^DIQ(2,DFN,.09),SSN=$E(SSN,6,9)
. S NPAT=" "_PNM_" "_SSN
. ;
. ; Is the mail message getting too big?
. I CURSIZE+$L(NPAT)>MAXSIZE D
. . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
. . K MSG
. . S CURSIZE=0,LNCTR=2
. . S MSG(1)="The Covered By Health Insurance field for the following deceased"
. . S CURSIZE=CURSIZE+$L(MSG(1))
. . S MSG(2)="was automatically set to 'N'"
. . S CURSIZE=CURSIZE+$L(MSG(2))
. S LNCTR=LNCTR+1
. S MSG(LNCTR)=NPAT
. S CURSIZE=CURSIZE+$L(NPAT)
;
D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
K ^TMP($J,"PATLIST"),^TMP($J,"ERRLIST")
Q
;
CHGCOV(DFN,HCOV) ; Update the Covered By Health Insurance field
; Input: DFN - IEN of the patient being updated
; HCOV - Current value of Covered By Health Insurance field
; ^TMP($J,"ERRLIST") - Current array of update errors
; Output: ^TMP($J,"ERRLIST") - Updated array of update errors
N DA,FDA,IBERR,IBSUPRES
N $ESTACK,$ETRAP
S $ETRAP="D COVERR^IBY579PO"
S IBSUPRES=1
D COVERED^IBCNSM31(DFN,HCOV) ; Set the Health Coverage flag to 'N'
Q
;
COVERR ; Called when an error occurs changing the Covered By Health Insurance field
; deceased patients. Note: This usually occurs because of a known FileMan error and a
; collision of a post-filing routine updating file 2.312 with a nightly KPAS
; extract doing inquiries into the 2.312 file at the same time.
;
; If an error occurs, this method will add the patient where the error occurred
; onto the error list for manual processing and move on to the next patient.
; Input: DFN - IIEN of the patient that was being worked
; when the error occurred
; ^TMP($J,"ERRLIST") - Current array of patients that had filing
; errors
; Output: ^TMP($J,"ERRLIST") - Updated array of patients that had filing errors
S ^TMP($J,"ERRLIST",DFN)="" ; Log collision error
S $ECODE="" ; Ignore error and continue
Q
;
DONE ; Displays the 'Done' message and finishes the progress bar
; Input: IBXPD - Post-Installation step being performed
D MES^XPDUTL(" Done.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY579PO 7429 printed Dec 13, 2024@02:34:39 Page 2
IBY579PO ;ALB/FA - IB*2.0*579 POST-INSTALL ;27-OCT-2016
+1 ;;2.0;INTEGRATED BILLING;**579**;21-MAR-94;Build 2
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ;Entry point
+1 NEW IBXPD,XPDIDTOT
+2 SET XPDIDTOT=1
+3 ;
+4 ; Update Covered by Health Insurance field (file 2, field .3192) for deceased patients
+5 SET IBXPD=1
+6 DO HCOV(IBXPD,XPDIDTOT)
+7 DO DONE
+8 QUIT
+9 ;
HCOV(IBXPD,XPDIDTOT) ; Update Covered by Health Insurance field for deceased patients
+1 ; Input: XBXPD - Post Installation Step
+2 ; XPDIDTOT - Total # of Post Installation steps
+3 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+4 DO MES^XPDUTL("-------------")
+5 DO MES^XPDUTL("Update Covered By Health Insurance field for deceased patients.")
+6 ; 1 - For every patient in the patient file check if the patient is deceased field
+7 ; (file 2, field .351)
+8 ; 2 - Quit if the patient is not deceased
+9 ; 3 - Quit if the Covered By Health Insurance field is already set to 'N'
+10 ; 3 - Quit if all of the patient's policies are not expired
+11 ; 4 - Change the Covered By Health Insurance field to 'N'
+12 ; 5 - Add this patient to a list of patients being modified
+13 ; 6 - Email the list of patients modified to xxx
+14 ;
+15 NEW MTIME,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
+16 ; Fileman date/time
SET MTIME=$$NOW^XLFDT()
+17 ; Set to queue 4 hours later
SET MTIME=$$FMADD^XLFDT(MTIME,0,4)
+18 ; Convert to $H format
SET ZTDTH=$$FMTH^XLFDT(MTIME)
+19 ;
+20 ; Set up the other TaskManager variables
+21 SET ZTRTN="HCOV2^IBY579PO"
+22 SET ZTDESC="IB*2.0*579 Change 'Covered By Health Insurance' field for deceased patients"
+23 SET ZTIO=""
+24 ; Call TaskManager
DO ^%ZTLOAD
+25 QUIT
+26 ;
HCOV2 ;EP
+1 ; Called from Task Manager
+2 NEW CURSIZE,DFN,DOD,EMAIL,EXPDT,HCOV,HCOVN,IIEN,LNCTR,MAXSIZE,MLGRP,MSG,NPAT,NOTEXP
+3 NEW PNM,SSN,SUBJECT,XMY,XX,YY
+4 KILL ^TMP($JOB,"PATLIST"),^TMP($JOB,"ERRLIST")
+5 SET DFN=0
+6 FOR
Begin DoDot:1
+7 SET DFN=$ORDER(^DPT(DFN))
+8 if '+DFN
QUIT
+9 ; Date of Death
SET DOD=$$GET1^DIQ(2,DFN_",",.351,"I")
+10 ; Patient is not Deceased
if DOD=""
QUIT
+11 ; Covered By Health Insurance flag
SET HCOV=$$GET1^DIQ(2,DFN_",",.3192,"I")
+12 ; Covered By Health Insurance already 'N' or "U"
if HCOV=""!(HCOV="N")!(HCOV="U")
QUIT
+13 SET IIEN=0
SET NOTEXP=0
+14 FOR
Begin DoDot:2
+15 SET IIEN=$ORDER(^DPT(DFN,.312,IIEN))
+16 if '+IIEN
QUIT
+17 ; Policy Expiration Date
SET EXPDT=$$GET1^DIQ(2.312,IIEN_","_DFN_",",3,"I")
+18 ; Policy has an expiration date
if EXPDT'=""
QUIT
+19 SET NOTEXP=1
End DoDot:2
if '+IIEN
QUIT
if NOTEXP
QUIT
+20 ; Not all plans are expired
if NOTEXP
QUIT
+21 ; Set the Health Coverage flag to 'N'
DO CHGCOV(DFN,HCOV)
+22 ; On error list
if $DATA(^TMP($JOB,"ERRLIST",DFN))
QUIT
+23 ; New Covered By Health Insurance flag
SET HCOVN=$$GET1^DIQ(2,DFN_",",.3192,"I")
+24 ; Deceased patient with coverage, skip
if HCOVN="Y"
QUIT
+25 ; Add Patient to list
SET ^TMP($JOB,"PATLIST",DFN)=""
End DoDot:1
if '+DFN
QUIT
+26 ;
+27 ; No patients to update
IF '$DATA(^TMP($JOB,"PATLIST"))
IF '$DATA(^TMP($JOB,"ERRLIST"))
QUIT
+28 ;
+29 ; Get array of users with the 'IB SUPERVISOR' security key
+30 DO GETPER^IBCNEUT7("IB SUPERVISOR",.XMY)
+31 ;
+32 ; Begin email set up
+33 SET MAXSIZE=300000
SET CURSIZE=0
SET LNCTR=0
+34 SET MLGRP=$$MGRP^IBCNEUT5
+35 SET SUBJECT="eIV: Change Covered By Health Insurance field for deceased patient - Post Install Task"
+36 ;
+37 ; First add any patients that had filing errors
+38 IF $DATA(^TMP($JOB,"ERRLIST"))
Begin DoDot:1
+39 SET LNCTR=LNCTR+1
+40 SET XX(1)="The following patients will need to be manually updated by removing and "
+41 SET XX(2)="re-entering the policy expiration date for one of the patient's policies "
+42 SET XX(3)="so that the 'Covered By Health Insurance' field will be corrected:"
+43 SET YY=$LENGTH(XX(1))+$LENGTH(XX(2))+$LENGTH(XX(3))
+44 ;
+45 ; Is the mail message getting too big?
+46 IF (CURSIZE+YY)>MAXSIZE
Begin DoDot:2
+47 DO MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
+48 KILL MSG
+49 SET CURSIZE=0
SET LNCTR=1
End DoDot:2
+50 ;
+51 SET MSG(LNCTR)=XX(1)
SET CURSIZE=CURSIZE+$LENGTH(XX(1))
SET LNCTR=LNCTR+1
+52 SET MSG(LNCTR)=XX(2)
SET CURSIZE=CURSIZE+$LENGTH(XX(2))
SET LNCTR=LNCTR+1
+53 SET MSG(LNCTR)=XX(3)
SET CURSIZE=CURSIZE+$LENGTH(XX(3))
+54 SET DFN=""
+55 FOR
Begin DoDot:2
+56 SET DFN=$ORDER(^TMP($JOB,"ERRLIST",DFN))
+57 if DFN=""
QUIT
+58 SET PNM=$$GET1^DIQ(2,DFN,.01)
+59 SET SSN=$$GET1^DIQ(2,DFN,.09)
SET SSN=$EXTRACT(SSN,6,9)
+60 SET NPAT=" "_PNM_" "_SSN
+61 ;
+62 ; Is the mail message getting too big?
+63 IF CURSIZE+$LENGTH(NPAT)>MAXSIZE
Begin DoDot:3
+64 DO MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
+65 KILL MSG
+66 SET LNCTR=3
SET MSG(1)=XX(1)
SET MSG(2)=XX(2)
SET MSG(3)=XX(3)
SET CURSIZE=YY
End DoDot:3
+67 SET LNCTR=LNCTR+1
+68 SET MSG(LNCTR)=NPAT
+69 SET CURSIZE=CURSIZE+$LENGTH(NPAT)
End DoDot:2
if DFN=""
QUIT
+70 SET LNCTR=LNCTR+1
SET MSG(LNCTR)=""
SET LNCTR=LNCTR+1
SET MSG(LNCTR)=""
End DoDot:1
+71 ;
+72 ; Next add the patients whose Covered By Health Insurance flag was set to 'N'
+73 SET LNCTR=LNCTR+1
+74 SET MSG(LNCTR)="The 'Covered By Health Insurance' field for the following deceased"
+75 SET CURSIZE=CURSIZE+$LENGTH(MSG(LNCTR))
+76 SET LNCTR=LNCTR+1
+77 SET MSG(LNCTR)="patients was automatically set to 'NO':"
+78 SET CURSIZE=CURSIZE+$LENGTH(MSG(LNCTR))
+79 SET DFN=""
+80 FOR
Begin DoDot:1
+81 SET DFN=$ORDER(^TMP($JOB,"PATLIST",DFN))
+82 if DFN=""
QUIT
+83 SET PNM=$$GET1^DIQ(2,DFN,.01)
+84 SET SSN=$$GET1^DIQ(2,DFN,.09)
SET SSN=$EXTRACT(SSN,6,9)
+85 SET NPAT=" "_PNM_" "_SSN
+86 ;
+87 ; Is the mail message getting too big?
+88 IF CURSIZE+$LENGTH(NPAT)>MAXSIZE
Begin DoDot:2
+89 DO MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
+90 KILL MSG
+91 SET CURSIZE=0
SET LNCTR=2
+92 SET MSG(1)="The Covered By Health Insurance field for the following deceased"
+93 SET CURSIZE=CURSIZE+$LENGTH(MSG(1))
+94 SET MSG(2)="was automatically set to 'N'"
+95 SET CURSIZE=CURSIZE+$LENGTH(MSG(2))
End DoDot:2
+96 SET LNCTR=LNCTR+1
+97 SET MSG(LNCTR)=NPAT
+98 SET CURSIZE=CURSIZE+$LENGTH(NPAT)
End DoDot:1
if DFN=""
QUIT
+99 ;
+100 DO MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
+101 KILL ^TMP($JOB,"PATLIST"),^TMP($JOB,"ERRLIST")
+102 QUIT
+103 ;
CHGCOV(DFN,HCOV) ; Update the Covered By Health Insurance field
+1 ; Input: DFN - IEN of the patient being updated
+2 ; HCOV - Current value of Covered By Health Insurance field
+3 ; ^TMP($J,"ERRLIST") - Current array of update errors
+4 ; Output: ^TMP($J,"ERRLIST") - Updated array of update errors
+5 NEW DA,FDA,IBERR,IBSUPRES
+6 NEW $ESTACK,$ETRAP
+7 SET $ETRAP="D COVERR^IBY579PO"
+8 SET IBSUPRES=1
+9 ; Set the Health Coverage flag to 'N'
DO COVERED^IBCNSM31(DFN,HCOV)
+10 QUIT
+11 ;
COVERR ; Called when an error occurs changing the Covered By Health Insurance field
+1 ; deceased patients. Note: This usually occurs because of a known FileMan error and a
+2 ; collision of a post-filing routine updating file 2.312 with a nightly KPAS
+3 ; extract doing inquiries into the 2.312 file at the same time.
+4 ;
+5 ; If an error occurs, this method will add the patient where the error occurred
+6 ; onto the error list for manual processing and move on to the next patient.
+7 ; Input: DFN - IIEN of the patient that was being worked
+8 ; when the error occurred
+9 ; ^TMP($J,"ERRLIST") - Current array of patients that had filing
+10 ; errors
+11 ; Output: ^TMP($J,"ERRLIST") - Updated array of patients that had filing errors
+12 ; Log collision error
SET ^TMP($JOB,"ERRLIST",DFN)=""
+13 ; Ignore error and continue
SET $ECODE=""
+14 QUIT
+15 ;
DONE ; Displays the 'Done' message and finishes the progress bar
+1 ; Input: IBXPD - Post-Installation step being performed
+2 DO MES^XPDUTL(" Done.")
+3 QUIT
+4 ;
