IBCOC1 ;ALB/NLR - NEW, NOT VERIFIED INS. ENTRIES ;24-NOV-93
;;2.0;INTEGRATED BILLING;**528,602**;21-MAR-94;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
% ;
N POP,ZTQUEUED,ZTREQ
; -- fileman print of new, not verified insurance entries
;
W !!,"Print List of New, Not Verified Insurance Entries"
;
; Report or Excel format
S IBOUT=$$OUT G:IBOUT="" END
I IBOUT="E" G EXCEL
;
W !!,"You will need a 132 column printer for this report!",!!
;
S DIC="^DPT(",FLDS="[IBNOTVER]",BY="[IBNOTVER1]"
D ASK G:$G(IBQ)=1 END
S DHD="REPORT OF NEW, NOT VERIFIED INSURANCE ENTRIES FROM: "_FR(1)_" TO: "_TO(1)
D EN1^DIP,ASK^IBCOMC2
;
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
END K DIC,FLDS,BY,FR,TO,IBOUT,IBQ,DHD
Q
ASK ;
N IBBDT,IBEDT
D DATE^IBOUTL
I (IBBDT<1)!(IBEDT<1) S IBQ=1
S FR=",,"_IBBDT_",?",TO=",,"_IBEDT_",?"
S FR(1)=$$DAT1^IBOUTL(IBBDT),TO(1)=$$DAT1^IBOUTL(IBEDT)
Q
;
OUT() ;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR I $D(DIRUT) Q ""
Q Y
;
EXCEL ;
; Ask for Date Entered range
N IBBDT,IBEDT,IBRF,IBRL,IBQUIT
S IBQUIT=0
D DATE^IBOUTL
I (IBBDT<1)!(IBEDT<1) G XLQUIT
;
D NR G:IBQUIT XLQUIT
;
W !! D QUE
;
XLQUIT ;
K IBBDT,IBEDT,IBRF,IBRL,IBOUT,IBQUIT
Q
;
NR ; Ask Name Range
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
NRR S DIR(0)="FO",DIR("B")="FIRST",DIR("A")=" START WITH NAME"
D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
S:Y="FIRST" Y="A" S IBRF=Y
S DIR(0)="FO",DIR("B")="LAST",DIR("A")=" GO TO NAME"
D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
S:Y="LAST" Y="zzzzzz" S IBRL=Y
I $G(IBRL)']$G(IBRF) W !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",! G NRR
Q
;
QUE ; Ask Device for Excel Output
N %ZIS,ZTRTN,ZTSAVE,ZTDESC
S %ZIS="QM" D ^%ZIS G:POP QUEQ
I $D(IO("Q")) K IO("Q") D G QUEQ
.S ZTRTN="COMPXL^IBCOC1",ZTSAVE("IBRF")="",ZTSAVE("IBRL")=""
.S ZTSAVE("IBBDT")="",ZTSAVE("IBEDT")=""
.S ZTDESC="IB - List New not Verified Policies"
.D ^%ZTLOAD K ZTSK D HOME^%ZIS
;
U IO
D COMPXL
;
QUEQ ; Exit clean-up
W ! D ^%ZISC K IBBDT,IBEDT,IBOUT,IBRF,IBRL,VA,VAERR,VADM,VAPA,^TMP("IBCOC1",$J)
Q
;
COMPXL ; Compile Excel data
; Input variables:
; IBRF - Required. Name Range Start value
; IBRL - Required. Name Range Go To value
; IBBDT - Required. Begining Entered Date Range
; IBEDT - Required. Ending Entered Date Range
;
N IBC,IBCDA,IBCDA0,IBCDA1,IBSSN,IBINS,IBSUBID,IBENDT,IBENUSR,DFN,VA,VADM,VAERR,VAPA
K ^TMP("IBCOC1",$J)
S IBC=0 F S IBC=$O(^DPT("AB",IBC)) Q:'IBC D
.S DFN=0 F S DFN=$O(^DPT("AB",IBC,DFN)) Q:'DFN D
..K VA,VADM,VAERR,VAPA
..D DEM^VADPT,ADD^VADPT
..;
..; I Pt. name out of range quit
..S VADM(1)=$P($G(VADM(1)),U,1) I VADM(1)="" Q
..I VADM(1)]IBRL Q
..I IBRF]VADM(1) Q
..;
..S IBCDA=0 F S IBCDA=$O(^DPT("AB",IBC,DFN,IBCDA)) Q:'IBCDA D
...S IBCDA0=$$ZND^IBCNS1(DFN,IBCDA) ;516 - baa
...;
...; I Verification Date populated quit
...S IBCDA1=$G(^DPT(DFN,.312,IBCDA,1))
...I $P(IBCDA1,U,3) Q
...;
...; I Entered Date out of range quit
...I +$P(IBCDA1,U)>IBEDT Q
...I +$P(IBCDA1,U)<IBBDT Q
...;
...; Get data fields
...S IBSSN=$$GET1^DIQ(2,DFN,.09)
...S IBINS=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",.01)
...S IBSUBID=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",7.02)
...S IBENUSR=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",1.02)
...S IBENDT=$$FMTE^XLFDT($P(IBCDA1,U),1)
...;
...; Set global array
...S ^TMP("IBCOC1",$J,VADM(1),IBCDA)=VADM(1)_U_IBSSN_U_IBINS_U_IBSUBID_U_IBENUSR_U_IBENDT
;
;IB*2.0*602 Add title to Excel Report
W "REPORT OF NEW, NOT VERIFIED INSURANCE ENTRIES FROM: ",$$DAT1^IBOUTL(IBBDT)," TO: ",$$DAT1^IBOUTL(IBEDT)
W !,"NAMES RANGING FROM ",$S(IBRF="A":"FIRST",1:IBRF)," TO ",$S(IBRL="zzzzzz":"LAST",1:IBRL)_"^"_$$FMTE^XLFDT($$NOW^XLFDT,"Z"),! ; IB*2.0*602
; IB*602/HN end
W "PATIENT^PATIENT ID^INSURANCE CO^SUBSCRIBER ID^WHO ENTERED^DATE ENTERED"
I '$D(^TMP("IBCOC1",$J)) W !!,"** NO RECORDS FOUND **" D ASK^IBCOMC2 Q
D WRT,ASK^IBCOMC2
;
Q
;
WRT ; Print Excel data
N IBPAT,IBINSTYP
S (IBPAT,IBINSTYP)=""
F S IBPAT=$O(^TMP("IBCOC1",$J,IBPAT)) Q:IBPAT="" D
.F S IBINSTYP=$O(^TMP("IBCOC1",$J,IBPAT,IBINSTYP)) Q:'IBINSTYP W !,^TMP("IBCOC1",$J,IBPAT,IBINSTYP)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCOC1 4406 printed Apr 09, 2024@21:03:49 Page 2
IBCOC1 ;ALB/NLR - NEW, NOT VERIFIED INS. ENTRIES ;24-NOV-93
+1 ;;2.0;INTEGRATED BILLING;**528,602**;21-MAR-94;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
% ;
+1 NEW POP,ZTQUEUED,ZTREQ
+2 ; -- fileman print of new, not verified insurance entries
+3 ;
+4 WRITE !!,"Print List of New, Not Verified Insurance Entries"
+5 ;
+6 ; Report or Excel format
+7 SET IBOUT=$$OUT
if IBOUT=""
GOTO END
+8 IF IBOUT="E"
GOTO EXCEL
+9 ;
+10 WRITE !!,"You will need a 132 column printer for this report!",!!
+11 ;
+12 SET DIC="^DPT("
SET FLDS="[IBNOTVER]"
SET BY="[IBNOTVER1]"
+13 DO ASK
if $GET(IBQ)=1
GOTO END
+14 SET DHD="REPORT OF NEW, NOT VERIFIED INSURANCE ENTRIES FROM: "_FR(1)_" TO: "_TO(1)
+15 DO EN1^DIP
DO ASK^IBCOMC2
+16 ;
+17 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+18 DO ^%ZISC
END KILL DIC,FLDS,BY,FR,TO,IBOUT,IBQ,DHD
+1 QUIT
ASK ;
+1 NEW IBBDT,IBEDT
+2 DO DATE^IBOUTL
+3 IF (IBBDT<1)!(IBEDT<1)
SET IBQ=1
+4 SET FR=",,"_IBBDT_",?"
SET TO=",,"_IBEDT_",?"
+5 SET FR(1)=$$DAT1^IBOUTL(IBBDT)
SET TO(1)=$$DAT1^IBOUTL(IBEDT)
+6 QUIT
+7 ;
OUT() ;
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
IF $DATA(DIRUT)
QUIT ""
+7 QUIT Y
+8 ;
EXCEL ;
+1 ; Ask for Date Entered range
+2 NEW IBBDT,IBEDT,IBRF,IBRL,IBQUIT
+3 SET IBQUIT=0
+4 DO DATE^IBOUTL
+5 IF (IBBDT<1)!(IBEDT<1)
GOTO XLQUIT
+6 ;
+7 DO NR
if IBQUIT
GOTO XLQUIT
+8 ;
+9 WRITE !!
DO QUE
+10 ;
XLQUIT ;
+1 KILL IBBDT,IBEDT,IBRF,IBRL,IBOUT,IBQUIT
+2 QUIT
+3 ;
NR ; Ask Name Range
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
NRR SET DIR(0)="FO"
SET DIR("B")="FIRST"
SET DIR("A")=" START WITH NAME"
+1 DO ^DIR
IF ($DATA(DTOUT))!($DATA(DUOUT))
SET IBQUIT=1
QUIT
+2 if Y="FIRST"
SET Y="A"
SET IBRF=Y
+3 SET DIR(0)="FO"
SET DIR("B")="LAST"
SET DIR("A")=" GO TO NAME"
+4 DO ^DIR
IF ($DATA(DTOUT))!($DATA(DUOUT))
SET IBQUIT=1
QUIT
+5 if Y="LAST"
SET Y="zzzzzz"
SET IBRL=Y
+6 IF $GET(IBRL)']$GET(IBRF)
WRITE !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",!
GOTO NRR
+7 QUIT
+8 ;
QUE ; Ask Device for Excel Output
+1 NEW %ZIS,ZTRTN,ZTSAVE,ZTDESC
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO QUEQ
+3 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+4 SET ZTRTN="COMPXL^IBCOC1"
SET ZTSAVE("IBRF")=""
SET ZTSAVE("IBRL")=""
+5 SET ZTSAVE("IBBDT")=""
SET ZTSAVE("IBEDT")=""
+6 SET ZTDESC="IB - List New not Verified Policies"
+7 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO QUEQ
+8 ;
+9 USE IO
+10 DO COMPXL
+11 ;
QUEQ ; Exit clean-up
+1 WRITE !
DO ^%ZISC
KILL IBBDT,IBEDT,IBOUT,IBRF,IBRL,VA,VAERR,VADM,VAPA,^TMP("IBCOC1",$JOB)
+2 QUIT
+3 ;
COMPXL ; Compile Excel data
+1 ; Input variables:
+2 ; IBRF - Required. Name Range Start value
+3 ; IBRL - Required. Name Range Go To value
+4 ; IBBDT - Required. Begining Entered Date Range
+5 ; IBEDT - Required. Ending Entered Date Range
+6 ;
+7 NEW IBC,IBCDA,IBCDA0,IBCDA1,IBSSN,IBINS,IBSUBID,IBENDT,IBENUSR,DFN,VA,VADM,VAERR,VAPA
+8 KILL ^TMP("IBCOC1",$JOB)
+9 SET IBC=0
FOR
SET IBC=$ORDER(^DPT("AB",IBC))
if 'IBC
QUIT
Begin DoDot:1
+10 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("AB",IBC,DFN))
if 'DFN
QUIT
Begin DoDot:2
+11 KILL VA,VADM,VAERR,VAPA
+12 DO DEM^VADPT
DO ADD^VADPT
+13 ;
+14 ; I Pt. name out of range quit
+15 SET VADM(1)=$PIECE($GET(VADM(1)),U,1)
IF VADM(1)=""
QUIT
+16 IF VADM(1)]IBRL
QUIT
+17 IF IBRF]VADM(1)
QUIT
+18 ;
+19 SET IBCDA=0
FOR
SET IBCDA=$ORDER(^DPT("AB",IBC,DFN,IBCDA))
if 'IBCDA
QUIT
Begin DoDot:3
+20 ;516 - baa
SET IBCDA0=$$ZND^IBCNS1(DFN,IBCDA)
+21 ;
+22 ; I Verification Date populated quit
+23 SET IBCDA1=$GET(^DPT(DFN,.312,IBCDA,1))
+24 IF $PIECE(IBCDA1,U,3)
QUIT
+25 ;
+26 ; I Entered Date out of range quit
+27 IF +$PIECE(IBCDA1,U)>IBEDT
QUIT
+28 IF +$PIECE(IBCDA1,U)<IBBDT
QUIT
+29 ;
+30 ; Get data fields
+31 SET IBSSN=$$GET1^DIQ(2,DFN,.09)
+32 SET IBINS=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",.01)
+33 SET IBSUBID=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",7.02)
+34 SET IBENUSR=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",1.02)
+35 SET IBENDT=$$FMTE^XLFDT($PIECE(IBCDA1,U),1)
+36 ;
+37 ; Set global array
+38 SET ^TMP("IBCOC1",$JOB,VADM(1),IBCDA)=VADM(1)_U_IBSSN_U_IBINS_U_IBSUBID_U_IBENUSR_U_IBENDT
End DoDot:3
End DoDot:2
End DoDot:1
+39 ;
+40 ;IB*2.0*602 Add title to Excel Report
+41 WRITE "REPORT OF NEW, NOT VERIFIED INSURANCE ENTRIES FROM: ",$$DAT1^IBOUTL(IBBDT)," TO: ",$$DAT1^IBOUTL(IBEDT)
+42 ; IB*2.0*602
WRITE !,"NAMES RANGING FROM ",$SELECT(IBRF="A":"FIRST",1:IBRF)," TO ",$SELECT(IBRL="zzzzzz":"LAST",1:IBRL)_"^"_$$FMTE^XLFDT($$NOW^XLFDT,"Z"),!
+43 ; IB*602/HN end
+44 WRITE "PATIENT^PATIENT ID^INSURANCE CO^SUBSCRIBER ID^WHO ENTERED^DATE ENTERED"
+45 IF '$DATA(^TMP("IBCOC1",$JOB))
WRITE !!,"** NO RECORDS FOUND **"
DO ASK^IBCOMC2
QUIT
+46 DO WRT
DO ASK^IBCOMC2
+47 ;
+48 QUIT
+49 ;
WRT ; Print Excel data
+1 NEW IBPAT,IBINSTYP
+2 SET (IBPAT,IBINSTYP)=""
+3 FOR
SET IBPAT=$ORDER(^TMP("IBCOC1",$JOB,IBPAT))
if IBPAT=""
QUIT
Begin DoDot:1
+4 FOR
SET IBINSTYP=$ORDER(^TMP("IBCOC1",$JOB,IBPAT,IBINSTYP))
if 'IBINSTYP
QUIT
WRITE !,^TMP("IBCOC1",$JOB,IBPAT,IBINSTYP)
End DoDot:1
+5 QUIT
