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