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

IBY579PO.m

Go to the documentation of this file. 
  1. IBY579PO ;ALB/FA - IB*2.0*579 POST-INSTALL ;27-OCT-2016
  1.  ;;2.0;INTEGRATED BILLING;**579**;21-MAR-94;Build 2
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EN ;Entry point
  1.  N IBXPD,XPDIDTOT
  1.  S XPDIDTOT=1
  1.  ;
  1.  ; Update Covered by Health Insurance field (file 2, field .3192) for deceased patients
  1.  S IBXPD=1
  1.  D HCOV(IBXPD,XPDIDTOT)
  1.  D DONE
  1.  Q
  1.  ;
  1. HCOV(IBXPD,XPDIDTOT) ; Update Covered by Health Insurance field for deceased patients
  1.  ; Input:   XBXPD       - Post Installation Step
  1.  ;          XPDIDTOT    - Total # of Post Installation steps
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Update Covered By Health Insurance field for deceased patients.")
  1.  ; 1 - For every patient in the patient file check if the patient is deceased field
  1.  ;    (file 2, field .351)
  1.  ; 2 - Quit if the patient is not deceased
  1.  ; 3 - Quit if the Covered By Health Insurance field is already set to 'N'
  1.  ; 3 - Quit if all of the patient's policies are not expired
  1.  ; 4 - Change the Covered By Health Insurance field to 'N'
  1.  ; 5 - Add this patient to a list of patients being modified
  1.  ; 6 - Email the list of patients modified to xxx
  1.  ;
  1.  N MTIME,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
  1.  S MTIME=$$NOW^XLFDT()                      ; Fileman date/time
  1.  S MTIME=$$FMADD^XLFDT(MTIME,0,4)           ; Set to queue 4 hours later
  1.  S ZTDTH=$$FMTH^XLFDT(MTIME)                ; Convert to $H format
  1.  ;
  1.  ; Set up the other TaskManager variables
  1.  S ZTRTN="HCOV2^IBY579PO"
  1.  S ZTDESC="IB*2.0*579 Change 'Covered By Health Insurance' field for deceased patients"
  1.  S ZTIO=""
  1.  D ^%ZTLOAD ; Call TaskManager
  1.  Q
  1.  ;
  1. HCOV2 ;EP
  1.  ; Called from Task Manager
  1.  N CURSIZE,DFN,DOD,EMAIL,EXPDT,HCOV,HCOVN,IIEN,LNCTR,MAXSIZE,MLGRP,MSG,NPAT,NOTEXP
  1.  N PNM,SSN,SUBJECT,XMY,XX,YY
  1.  K ^TMP($J,"PATLIST"),^TMP($J,"ERRLIST")
  1.  S DFN=0
  1.  F  D  Q:'+DFN
  1.  . S DFN=$O(^DPT(DFN))
  1.  . Q:'+DFN
  1.  . S DOD=$$GET1^DIQ(2,DFN_",",.351,"I")     ; Date of Death
  1.  . Q:DOD=""                                 ; Patient is not Deceased
  1.  . S HCOV=$$GET1^DIQ(2,DFN_",",.3192,"I")   ; Covered By Health Insurance flag
  1.  . Q:HCOV=""!(HCOV="N")!(HCOV="U")          ; Covered By Health Insurance already 'N' or "U"
  1.  . S IIEN=0,NOTEXP=0
  1.  . F  D  Q:'+IIEN  Q:NOTEXP
  1.  . . S IIEN=$O(^DPT(DFN,.312,IIEN))
  1.  . . Q:'+IIEN
  1.  . . S EXPDT=$$GET1^DIQ(2.312,IIEN_","_DFN_",",3,"I")   ; Policy Expiration Date
  1.  . . Q:EXPDT'=""                                        ; Policy has an expiration date
  1.  . . S NOTEXP=1
  1.  . Q:NOTEXP                                 ; Not all plans are expired
  1.  . D CHGCOV(DFN,HCOV)                       ; Set the Health Coverage flag to 'N'
  1.  . Q:$D(^TMP($J,"ERRLIST",DFN))             ; On error list
  1.  . S HCOVN=$$GET1^DIQ(2,DFN_",",.3192,"I")  ; New Covered By Health Insurance flag
  1.  . Q:HCOVN="Y"                              ; Deceased patient with coverage, skip
  1.  . S ^TMP($J,"PATLIST",DFN)=""              ; Add Patient to list
  1.  ;
  1.  I '$D(^TMP($J,"PATLIST")),'$D(^TMP($J,"ERRLIST")) Q  ; No patients to update
  1.  ;
  1.  ; Get array of users with the 'IB SUPERVISOR' security key
  1.  D GETPER^IBCNEUT7("IB SUPERVISOR",.XMY)
  1.  ;
  1.  ; Begin email set up
  1.  S MAXSIZE=300000,CURSIZE=0,LNCTR=0
  1.  S MLGRP=$$MGRP^IBCNEUT5
  1.  S SUBJECT="eIV: Change Covered By Health Insurance field for deceased patient - Post Install Task"
  1.  ;
  1.  ; First add any patients that had filing errors
  1.  I $D(^TMP($J,"ERRLIST")) D
  1.  . S LNCTR=LNCTR+1
  1.  . S XX(1)="The following patients will need to be manually updated by removing and "
  1.  . S XX(2)="re-entering the policy expiration date for one of the patient's policies "
  1.  . S XX(3)="so that the 'Covered By Health Insurance' field will be corrected:"
  1.  . S YY=$L(XX(1))+$L(XX(2))+$L(XX(3))
  1.  . ;
  1.  . ; Is the mail message getting too big?
  1.  . I (CURSIZE+YY)>MAXSIZE D
  1.  . . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
  1.  . . K MSG
  1.  . . S CURSIZE=0,LNCTR=1
  1.  . ;
  1.  . S MSG(LNCTR)=XX(1),CURSIZE=CURSIZE+$L(XX(1)),LNCTR=LNCTR+1
  1.  . S MSG(LNCTR)=XX(2),CURSIZE=CURSIZE+$L(XX(2)),LNCTR=LNCTR+1
  1.  . S MSG(LNCTR)=XX(3),CURSIZE=CURSIZE+$L(XX(3))
  1.  . S DFN=""
  1.  . F  D  Q:DFN=""
  1.  . . S DFN=$O(^TMP($J,"ERRLIST",DFN))
  1.  . . Q:DFN=""
  1.  . . S PNM=$$GET1^DIQ(2,DFN,.01)
  1.  . . S SSN=$$GET1^DIQ(2,DFN,.09),SSN=$E(SSN,6,9)
  1.  . . S NPAT="      "_PNM_"  "_SSN
  1.  . . ;
  1.  . . ; Is the mail message getting too big?
  1.  . . I CURSIZE+$L(NPAT)>MAXSIZE D
  1.  . . . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
  1.  . . . K MSG
  1.  . . . S LNCTR=3,MSG(1)=XX(1),MSG(2)=XX(2),MSG(3)=XX(3),CURSIZE=YY
  1.  . . S LNCTR=LNCTR+1
  1.  . . S MSG(LNCTR)=NPAT
  1.  . . S CURSIZE=CURSIZE+$L(NPAT)
  1.  . S LNCTR=LNCTR+1,MSG(LNCTR)="",LNCTR=LNCTR+1,MSG(LNCTR)=""
  1.  ;
  1.  ; Next add the patients whose Covered By Health Insurance flag was set to 'N'
  1.  S LNCTR=LNCTR+1
  1.  S MSG(LNCTR)="The 'Covered By Health Insurance' field for the following deceased"
  1.  S CURSIZE=CURSIZE+$L(MSG(LNCTR))
  1.  S LNCTR=LNCTR+1
  1.  S MSG(LNCTR)="patients was automatically set to 'NO':"
  1.  S CURSIZE=CURSIZE+$L(MSG(LNCTR))
  1.  S DFN=""
  1.  F  D  Q:DFN=""
  1.  . S DFN=$O(^TMP($J,"PATLIST",DFN))
  1.  . Q:DFN=""
  1.  . S PNM=$$GET1^DIQ(2,DFN,.01)
  1.  . S SSN=$$GET1^DIQ(2,DFN,.09),SSN=$E(SSN,6,9)
  1.  . S NPAT="      "_PNM_"  "_SSN
  1.  . ;
  1.  . ; Is the mail message getting too big?
  1.  . I CURSIZE+$L(NPAT)>MAXSIZE D
  1.  . . D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
  1.  . . K MSG
  1.  . . S CURSIZE=0,LNCTR=2
  1.  . . S MSG(1)="The Covered By Health Insurance field for the following deceased"
  1.  . . S CURSIZE=CURSIZE+$L(MSG(1))
  1.  . . S MSG(2)="was automatically set to 'N'"
  1.  . . S CURSIZE=CURSIZE+$L(MSG(2))
  1.  . S LNCTR=LNCTR+1
  1.  . S MSG(LNCTR)=NPAT
  1.  . S CURSIZE=CURSIZE+$L(NPAT)
  1.  ;
  1.  D MSG^IBCNEUT5(MLGRP,SUBJECT,"MSG(",,.XMY)
  1.  K ^TMP($J,"PATLIST"),^TMP($J,"ERRLIST")
  1.  Q
  1.  ;
  1. CHGCOV(DFN,HCOV) ; Update the Covered By Health Insurance field
  1.  ; Input:   DFN                 - IEN of the patient being updated
  1.  ;          HCOV                - Current value of Covered By Health Insurance field
  1.  ;          ^TMP($J,"ERRLIST")  - Current array of update errors
  1.  ; Output:  ^TMP($J,"ERRLIST")  - Updated array of update errors
  1.  N DA,FDA,IBERR,IBSUPRES
  1.  N $ESTACK,$ETRAP
  1.  S $ETRAP="D COVERR^IBY579PO"
  1.  S IBSUPRES=1
  1.  D COVERED^IBCNSM31(DFN,HCOV)             ; Set the Health Coverage flag to 'N'
  1.  Q
  1.  ;
  1. 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
  1.  ; collision of a post-filing routine updating file 2.312 with a nightly KPAS
  1.  ; extract doing inquiries into the 2.312 file at the same time.
  1.  ;
  1.  ; If an error occurs, this method will add the patient where the error occurred
  1.  ; onto the error list for manual processing and move on to the next patient.
  1.  ; Input:   DFN                 - IIEN of the patient that was being worked 
  1.  ;                                when the error occurred
  1.  ;          ^TMP($J,"ERRLIST")  - Current array of patients that had filing 
  1.  ;                                errors
  1.  ; Output:  ^TMP($J,"ERRLIST") - Updated array of patients that had filing errors
  1.  S ^TMP($J,"ERRLIST",DFN)=""                ; Log collision error
  1.  S $ECODE=""                                ; Ignore error and continue
  1.  Q
  1.  ;
  1. DONE ; Displays the 'Done' message and finishes the progress bar
  1.  ; Input: IBXPD - Post-Installation step being performed
  1.  D MES^XPDUTL(" Done.")
  1.  Q
  1.  ;