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