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

IBCEP8C1.m

Go to the documentation of this file. 
  1. IBCEP8C1 ;DSS/SCR - Functions for IB SILENT INTERFACE FROM FB ;03-27-12
  1.  ;;2.0;INTEGRATED BILLING;**476**;21-MAR-94;Build 2
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; This routine contains functions to support the Non-VA Items from the
  1.  ; Provider ID Maintenance Main Menu
  1. FBTGLGET(IBNPRV)  ;EP from IBCEP8B
  1.  ;  Provider ID Maintenance Main Menu
  1.  ;  for display on screens created for NP Non-VA Provider and NF Non-VA facility selections
  1.  ;
  1.  ; INPUTS: IBNPRV  : IEN of the IB NON/OTHER VA BILLING PROVIDER file
  1.  ;
  1.  ; OUTPUT : returns 1 if currently set to 'ALLOW' or not set, 0 if currently set to 'DISALLOW'
  1.  ;        : a NULL return indicates a DB read error
  1.  ;
  1.  N IBTGLNUM,IBTGLVAL,IBERR
  1.  ;
  1.  S IBTGLNUM=9999999
  1.  S IBTGLNUM=$O(^IBA(355.93,IBNPRV,3,IBTGLNUM),-1)   ;should return the most recent entry
  1.  I IBTGLNUM="" S IBTGLVAL=1
  1.  I IBTGLNUM'="" D
  1.  .S IBTGLVAL=$$GET1^DIQ(355.9351,IBTGLNUM_","_IBNPRV_",",".02","I","","IBERR")  ;355.9351 (#51) DATE/TIME ALLOW FB UPDATE
  1.  .I $G(IBERR("DIERR"))'="" S IBTGLVAL=""   ;
  1.  Q IBTGLVAL
  1.  ;
  1. FBTGLSET(IBNPRV)   ;EP from IBCEP8
  1.  ;INPUT IBNPRV : IEN of IB NON/OTHER VA BILLING PROVIDER
  1.  ;
  1.  N DIR,DTOUT,DUOUT,Y,DA,IBNEW,IBQUIT,IBOLD,IBLAST,IBNEXT
  1.  ;
  1.  S IBQUIT=0
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Allow future updates by FEE BASIS automatic interface"
  1.  S DIR("?")="Enter YES to allow automatic updates, NO not to"
  1.  S DA=IBNPRV
  1.  S DIR("B")="YES"
  1.  S IBNEXT=0
  1.  S IBQUIT=0
  1.  F  S IBNEXT=$O(^IBA(355.93,IBNPRV,3,IBNEXT)) Q:'+IBNEXT  S IBLAST=IBNEXT
  1.  S:'+$G(IBLAST) IBOLD=1
  1.  S:+$G(IBLAST) IBOLD=$P($G(^IBA(355.93,IBNPRV,3,IBLAST,0)),U,2)
  1.  S:IBOLD=0 DIR("B")="NO"
  1.  S:IBOLD=1 DIR("B")="YES"
  1.  D ^DIR
  1.  I $G(DTOUT)=1!$G(DUOUT)=1 S IBQUIT=1
  1.  S IBNEW=Y
  1.  I IBNEW="" S IBQUIT=1   ;don't update if we couldn't read
  1.  I (IBNEW'=IBOLD)&'IBQUIT D
  1.  .N DO,DD,X,%,%H,%I,IBNOW,IBFDA,IBRET
  1.  .D NOW^%DTC
  1.  .S IBNOW=%
  1.  .S IBFDA(355.9351,"+1,"_IBNPRV_",",".01")=IBNOW   ;355.9351  ;(#51) DATE/TIME ALLOW FB UPDATE INTERNAL
  1.  .S IBFDA(355.9351,"+1,"_IBNPRV_",",".02")=IBNEW  ;(#.02)CHANGED TO [2S]
  1.  .S IBFDA(355.9351,"+1,"_IBNPRV_",",".03")=DUZ  ;(#.03) IB USER WHO CHANGED [3P:200]
  1.  .D UPDATE^DIE("","IBFDA","IBRET","IBERR")
  1.  Q
  1.  ;
  1. EPFBRPT()  ;EP FOR IB PROVIDER FROM FB STAT RPT OPTION
  1.  ;
  1.  N IBIEN,IBDATE,IBFROM,IBTO,IBSTYLE,DIR,Y,IBQUIT,IBTYPE
  1.  ;
  1.  S IBQUIT=0
  1.  ;FIRST PROMT FOR DATES
  1.  F  Q:IBQUIT  D
  1.  .D CLEAR()
  1.  .W ?3,"** SUMMARY OF NON-VA PROVIDERS AFFECTED BY FEE BASIS INTERFACE **"
  1.  .W !!!!!
  1.  .S DIR("A")="SELECT FIRST date to include in report"
  1.  .S DIR(0)="DE"
  1.  .D ^DIR
  1.  .I $D(DUOUT) S IBQUIT=1  ;DEFINED IF USER ENTERS ONE UP ARROW
  1.  .I $D(DIRUT) S IBQUIT=1  ;DEFINED IF USER ENTERS ""
  1.  .I $D(DTOUT) S IBQUIT=1  ;DEFINED IF USER TIMES OUT
  1.  .W:'IBQUIT " "_Y(0)
  1.  .I 'IBQUIT D
  1.  ..S IBFROM=+Y
  1.  ..S DIR("A")="SELECT LAST date to include in report"
  1.  ..S DIR(0)="D"
  1.  ..D ^DIR
  1.  ..I $D(DUOUT) S IBQUIT=1  ;DEFINED IF USER ENTERS ONE UP ARROW
  1.  ..I $D(DIRUT) S IBQUIT=1  ;DEFINED IF USER ENTERS ""
  1.  ..I $D(DTOUT) S IBQUIT=1  ;DEFINED IF USER TIMES OUT
  1.  ..W:'IBQUIT " "_Y(0)
  1.  ..I 'IBQUIT S IBTO=+Y
  1.  .I 'IBQUIT D IBRPT(IBFROM,IBTO)
  1.  K ^TMP($J,"IBCEP8C1")
  1.  Q
  1.  ;
  1. IBRPT(IBFROM,IBTO)  ;reports from 355.935 (#50)DATE/TIME LAST FB UPDATE
  1.  ;
  1.  ;INPUTS IBFROM : Records modified FROM this date will be considered
  1.  ;       IBTO   : Records modified TO this date will be considered
  1.  ;
  1.  K ^TMP($J,"IBCEP8C1")
  1.  N IBNEXT,IBARRAY,IBIEN,IBCHKIEN
  1.  ;S DIC=355.93       ;IB NON/OTHER VA BILLING PROVIDER FILE
  1.  ;IBA(355.93,D0,4,0)=^355.935DA^^  (#50) DATE/TIME LAST FB UPDATE
  1.  S IBIEN=0
  1.  S IBNEXT=$P(IBFROM,".",1)_"."_0  ;first second of from date
  1.  F  S IBIEN=$O(^IBA(355.93,IBIEN)) Q:'+IBIEN  D
  1.  .S IBNEXT=IBFROM
  1.  .F  S IBNEXT=$O(^IBA(355.93,IBIEN,4,"B",IBNEXT)) Q:(IBNEXT>(IBTO+1))!(IBNEXT="")  D
  1.  ..S IBSUB=0  ;GATHER CHANGES FOR THIS DATE
  1.  ..F  S IBSUB=$O(^IBA(355.93,IBIEN,4,"B",IBNEXT,IBSUB)) Q:IBSUB=""  D
  1.  ...S ^TMP($J,"IBCEP8C1",IBNEXT,IBIEN,IBSUB)=^IBA(355.93,IBIEN,4,IBSUB,0)
  1.  ;Now count records by date
  1.  S ^TMP($J,"IBCEP8C1",0)=0  ;HOLDS THE NUMBER OF RECORDS MODIFIED BY THE INTERFACE FOR TIME FRAME
  1.  S ^TMP($J,"IBCEP8C1",0,1)=0 ;HOLDS THE NUMBER RECORDS CREATED BY THE INTERFACE FOR TIME FRAME
  1.  S IBNEXT=0
  1.  F  S IBNEXT=$O(^TMP($J,"IBCEP8C1",IBNEXT)) Q:IBNEXT=""  D
  1.  .S ^TMP($J,"IBCEP8C1",IBNEXT,0)=0  ;HOLDS THE NUMBER OF RECORDS MODIFIED BY THE INTERFACE FOR A DATE
  1.  .S ^TMP($J,"IBCEP8C1",IBNEXT,0,1)=0  ;HOLDS THE NUMBER OF RECORDS CREATED BY THE INTERFACE FOR A DATE
  1.  .S IBIEN=0
  1.  .F  S IBIEN=$O(^TMP($J,"IBCEP8C1",IBNEXT,IBIEN)) Q:IBIEN=""  D
  1.  ..S IBSUB=$O(^TMP($J,"IBCEP8C1",IBNEXT,IBIEN,0))
  1.  ..I $P(^TMP($J,"IBCEP8C1",IBNEXT,IBIEN,IBSUB),U,3)'=1 D
  1.  ...S ^TMP($J,"IBCEP8C1",IBNEXT,0)=$G(^TMP($J,"IBCEP8C1",IBNEXT,0))+1
  1.  ...S ^TMP($J,"IBCEP8C1",0)=$G(^TMP($J,"IBCEP8C1",0))+1
  1.  ..I $P(^TMP($J,"IBCEP8C1",IBNEXT,IBIEN,IBSUB),U,3)=1 D
  1.  ...S ^TMP($J,"IBCEP8C1",IBNEXT,0,1)=$G(^TMP($J,"IBCEP8C1",IBNEXT,0,1))+1
  1.  ...S ^TMP($J,"IBCEP8C1",0,1)=$G(^TMP($J,"IBCEP8C1",0,1))+1
  1.  D DAYIBRPT(IBTO,IBFROM)
  1.  Q
  1.  ;
  1. DAYIBRPT(IBTO,IBFROM)  ;PRINTS RECORDS BY DAY THAT WERE MODIFIED BY FB
  1.  ;
  1.  ;
  1.  N DIR,DUOUT,DIRUT,DTOUT,IBQUIT,IBIEN,X,Y,IBSUB,IBTYPE,IBDAT1,IBDAT2,IBDATE,IBIENS,IBSUBS
  1.  S IBQUIT=0
  1.  S %ZIS("A")="OUTPUT DEVICE: "
  1.  D ^%ZIS
  1.  I POP S IBQUIT=1 Q
  1.  S Y=IBFROM
  1.  D DD^%DT
  1.  S IBDAT1=Y
  1.  S Y=IBTO
  1.  D DD^%DT
  1.  S IBDAT2=Y
  1.  W !,?15,"*** IB PROVIDER FROM FB SUMMARY LISTING ***"
  1.  W !,?25,IBDAT1_" - "_IBDAT2
  1.  W !!,?3,"Includes information about records in the IB NON/OTHER BILLING PROVIDER"
  1.  W !,?3,"file modified by the FB PAID TO IB automatic interface for date range"
  1.  W !
  1.  S IBDATE=0
  1.  W !,?13,"TOTAL RECORDS MODIFIED FOR DATE RANGE: "_^TMP($J,"IBCEP8C1",0)
  1.  W !?16,"TOTAL RECORDS CREATED FOR DATE RANGE: "_^TMP($J,"IBCEP8C1",0,1)
  1.  F  S IBDATE=$O(^TMP($J,"IBCEP8C1",IBDATE)) Q:(IBDATE=""!IBQUIT)  D
  1.  .S Y=IBDATE
  1.  .D DD^%DT
  1.  .W !!,?3,"FB PROCESS DATE: "_Y
  1.  .W !,?5,"TOTAL RECORDS MODIFIED FOR THIS DATE: "_^TMP($J,"IBCEP8C1",IBDATE,0)
  1.  .W !,?8,"TOTAL RECORDS CREATED FOR THIS DATE: "_$G(^TMP($J,"IBCEP8C1",IBDATE,0,1))
  1.  .S IBIEN=0
  1.  .F  S IBIEN=$O(^TMP($J,"IBCEP8C1",IBDATE,IBIEN)) Q:IBIEN=""  D GETS^DIQ(355.93,IBIEN_",","**","","IBRET")
  1.  .S IBIEN=0
  1.  .S IBQUIT=0
  1.  .W !!,?3,"PROVIDER",?38,"NPI",?52,"TYPE",?63,"CREATED BY FB"
  1.  .W !,?3,"--------------------------------------------------------------------------"
  1.  .F  S IBIEN=$O(^TMP($J,"IBCEP8C1",IBDATE,IBIEN)) Q:(IBIEN="")!IBQUIT  D
  1.  ..W !,?3,$G(IBRET(355.93,IBIEN_",",.01))
  1.  ..S IBIENS=IBIEN_","
  1.  ..W ?38,$G(IBRET(355.93,IBIENS,41.01))
  1.  ..W ?52,$G(IBRET(355.93,IBIENS,.02))
  1.  ..S IBSUB=$O(^TMP($J,"IBCEP8C1",IBDATE,IBIEN,""))
  1.  ..S IBSUBS=IBSUB_","_IBIEN_","
  1.  ..W:$G(IBRET(355.935,IBSUBS,.03))'="" ?68,$G(IBRET(355.935,IBSUBS,.03))
  1.  ..W:$G(IBRET(355.935,IBSUBS,.03))="" ?68,"NO"
  1.  .I (IOT="VTRM") D
  1.  ..W !
  1.  ..S DIR("A")="Enter RETURN to continue or '^' to exit"
  1.  ..S DIR(0)="FO"
  1.  ..D ^DIR
  1.  ..I $D(DUOUT) S IBQUIT=1  ;DEFINED IF USER ENTERS ONE UP ARROWS
  1.  ..I $D(DTOUT) S IBQUIT=1  ;DEFINED IF USER TIMES OUT
  1.  ..I $O(^TMP($J,"IBCEP8C1",IBDATE))'="" D
  1.  ...W !!,?15,"*** IB PROVIDER FROM FB SUMMARY LISTING (CONT.)***"
  1.  ...W !,?25,IBDAT1_" - "_IBDAT2
  1.  .Q:IBQUIT
  1.  Q 
  1.  ;
  1. CLEAR()   ;clears screen between reports
  1.  N IBLINE
  1.  F IBLINE=1:1:15 W !
  1.  Q