- 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 Feb 18, 2025@23:44:35 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