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

IBCNUPD.m

Go to the documentation of this file.
  1. IBCNUPD ;ALB/TAZ - UPDATE SUBCRIBER INFO FOR SELECTED PATIENTS ; 07 Mar 2013 14:44 PM
  1. ;;2.0;INTEGRATED BILLING;**497,506**;21-MAR-94;Build 74
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; Call at tags only
  1. Q
  1. ;
  1. ;
  1. EN ; Entry Point for TaskMan. The routine should be called at label TASK since it will take awhile to complete.
  1. ;
  1. N DFN,FILE,INS,IBREL,IBVAL,IENS,FIELD,DATA,DA,DR,DIE,EXPDT,X,Y
  1. K ^TMP($J,"IBCNUPD")
  1. S DFN=0
  1. S FILE=2.312
  1. F S DFN=$O(^DPT(DFN)) Q:'DFN D
  1. . K ^UTILITY("VAPA",$J),^UTILITY("VADM",$J)
  1. . S INS=0
  1. . F S INS=$O(^DPT(DFN,.312,INS)) Q:'INS D
  1. .. I '$D(^DPT(DFN,.312,INS,0)) Q ;Don't process bad nodes.
  1. .. S IENS=INS_","_DFN_","
  1. .. S EXPDT=+$$GET1^DIQ(FILE,IENS,3,"I")
  1. .. I EXPDT,EXPDT<DT Q ;insurance expiration date exists and it's a past date which means inactive policy
  1. .. I $$GET1^DIQ(FILE,IENS,4.03)'="SELF" Q
  1. .. S IBREL=$$GET1^DIQ(FILE,IENS,4.03,"I")
  1. .. F FIELD=7.01,3.01,3.02,3.05,3.06,3.07,3.08,3.09,3.1,3.11,3.12 D ; IB*2.0*497 (vd)
  1. ... S DATA=$$GET1^DIQ(FILE,IENS,FIELD) I DATA'="" Q
  1. ... S IBVAL=$$PIDEF^IBCNSP1(IBREL,FIELD,DFN,0) I IBVAL="" Q
  1. ... S DIE="^DPT("_DFN_",.312,"
  1. ... S DA(1)=DFN,DA=INS
  1. ... S DR=FIELD_"///^S X=IBVAL"
  1. ... D ^DIE
  1. ;Send completion message
  1. D MAIL
  1. ;
  1. ENQ Q
  1. ;
  1. OPT ; Enter from the option
  1. W !,$$TASK()
  1. OPTQ ;
  1. Q
  1. ;
  1. TASK(IBQ) ;Set up task to run the option
  1. N X,Y,IDT,XDT,TSK,MSG,DTOUT,DUOUT
  1. ;
  1. ;If option is queued, set up queue date/time and bypass prompt
  1. I $G(IBQ) D G TASK1
  1. . S X="T+1@2100"
  1. . S %DT="FR"
  1. . D ^%DT
  1. ;
  1. W !,"*************************** IMPORTANT!! ********************************"
  1. W !,"This option will scan through the entire Patient File for patients with "
  1. W !,"insurance where the relationship to insured is self. Certain fields in "
  1. W !,"Insurance Type sub-file will be updated to match the patient data if it "
  1. W !,"does not already exist. This will take awhile and must be queued to run"
  1. W !,"in the background when there are few users on the system. The default is"
  1. W !,"Tomorrow at 9:00 p.m."
  1. W !
  1. ;
  1. ;Set Date and Time
  1. K %DT
  1. S %DT="AEFR"
  1. S %DT("A")="Enter date/time to queue the option: "
  1. S %DT("B")="T+1@2100"
  1. S %DT(0)="NOW" ; prevent past date/time being entered
  1. D ^%DT
  1. I $D(DTOUT)!$D(DUOUT)!(Y<0) S MSG="Task Aborted. Option NOT scheduled." G TASKQ
  1. ;
  1. TASK1 ;bypass for queued task
  1. S IDT=Y D DD^%DT S XDT=Y
  1. ;
  1. ;Check if task already scheduled for date/time
  1. S TSK=$$GETTASK(IDT)
  1. I TSK D G TASKQ
  1. . S Y=$P(TSK,U,2) D DD^%DT
  1. . S MSG=" Task (#"_+TSK_") already scheduled to run on "_Y
  1. ;
  1. ;Schedule the task
  1. S TSK=$$SCHED(IDT)
  1. ;
  1. ;Check for scheduling problem
  1. I 'TSK S MSG=" Task Could Not Be Scheduled" G TASKQ
  1. ;
  1. ;Send successful schedule message
  1. S MSG=" Update Subscriber Information Scheduled for "_XDT
  1. ;
  1. TASKQ ;
  1. Q MSG
  1. ;
  1. GETTASK(IDT) ;
  1. N TASK,TASKNO,TDT,XUSUCI,Y,ZTSK0
  1. ;
  1. ;Retrieve UCI
  1. X ^%ZOSF("UCI") S XUSUCI=Y
  1. ;
  1. S (TASK,TDT)=0,TASKNO=""
  1. F S TASK=$O(^%ZTSK(TASK)) Q:'TASK D Q:TASKNO
  1. .I $G(^%ZTSK(TASK,.03))["IBCN SUBSCRIBER UPDATE" D
  1. ..S ZTSK0=$G(^%ZTSK(TASK,0))
  1. ..;
  1. ..;Exclude tasks scheduled by TaskMan
  1. ..Q:ZTSK0["ZTSK^XQ1"
  1. ..;
  1. ..;Exclude tasks in other ucis
  1. ..Q:(($P(ZTSK0,U,11)_","_$P(ZTSK0,U,12))'=XUSUCI)
  1. ..;
  1. ..;Check for correct date and time
  1. ..S TDT=$$HTFM^XLFDT($P(ZTSK0,"^",6))
  1. ..;I TDT=IDT S TASKNO=TASK
  1. Q TASKNO_U_TDT
  1. ;
  1. ;Schedule Task
  1. ;
  1. SCHED(ZTDTH) ;
  1. N ZTRTN,ZTDESC,ZTIO,ZTSK
  1. S ZTRTN="EN^IBCNUPD"
  1. S ZTDESC="IBCN SUBSCRIBER UPDATE"
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. Q ZTSK
  1. ;
  1. MAIL ;Send completion message
  1. NEW XMDUZ,XMSUBJ,XMBODY,MSG,XMTO,DA,DIE,DR
  1. S XMDUZ=DUZ,XMSUBJ="Subscriber Update Has Completed",XMBODY="MSG"
  1. S MSG(1)="The Subscriber Update Option has completed at "
  1. S MSG(2)=" "
  1. S MSG(3)=" "_$$SITE^VASITE
  1. ;
  1. ; recipients of message
  1. S XMTO(DUZ)=""
  1. S XMTO("G.PATCHES")=""
  1. S XMTO("G.IB EDI")=""
  1. S XMTO("G.IB EDI SUPERVISOR")=""
  1. ;
  1. D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
  1. ;
  1. Q