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

IBCOC1.m

Go to the documentation of this file.
  1. IBCOC1 ;ALB/NLR - NEW, NOT VERIFIED INS. ENTRIES ;24-NOV-93
  1. ;;2.0;INTEGRATED BILLING;**528,602**;21-MAR-94;Build 22
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. % ;
  1. N POP,ZTQUEUED,ZTREQ
  1. ; -- fileman print of new, not verified insurance entries
  1. ;
  1. W !!,"Print List of New, Not Verified Insurance Entries"
  1. ;
  1. ; Report or Excel format
  1. S IBOUT=$$OUT G:IBOUT="" END
  1. I IBOUT="E" G EXCEL
  1. ;
  1. W !!,"You will need a 132 column printer for this report!",!!
  1. ;
  1. S DIC="^DPT(",FLDS="[IBNOTVER]",BY="[IBNOTVER1]"
  1. D ASK G:$G(IBQ)=1 END
  1. S DHD="REPORT OF NEW, NOT VERIFIED INSURANCE ENTRIES FROM: "_FR(1)_" TO: "_TO(1)
  1. D EN1^DIP,ASK^IBCOMC2
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. END K DIC,FLDS,BY,FR,TO,IBOUT,IBQ,DHD
  1. Q
  1. ASK ;
  1. N IBBDT,IBEDT
  1. D DATE^IBOUTL
  1. I (IBBDT<1)!(IBEDT<1) S IBQ=1
  1. S FR=",,"_IBBDT_",?",TO=",,"_IBEDT_",?"
  1. S FR(1)=$$DAT1^IBOUTL(IBBDT),TO(1)=$$DAT1^IBOUTL(IBEDT)
  1. Q
  1. ;
  1. OUT() ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. W !
  1. S DIR(0)="SA^E:Excel;R:Report"
  1. S DIR("A")="(E)xcel Format or (R)eport Format: "
  1. S DIR("B")="Report"
  1. D ^DIR I $D(DIRUT) Q ""
  1. Q Y
  1. ;
  1. EXCEL ;
  1. ; Ask for Date Entered range
  1. N IBBDT,IBEDT,IBRF,IBRL,IBQUIT
  1. S IBQUIT=0
  1. D DATE^IBOUTL
  1. I (IBBDT<1)!(IBEDT<1) G XLQUIT
  1. ;
  1. D NR G:IBQUIT XLQUIT
  1. ;
  1. W !! D QUE
  1. ;
  1. XLQUIT ;
  1. K IBBDT,IBEDT,IBRF,IBRL,IBOUT,IBQUIT
  1. Q
  1. ;
  1. NR ; Ask Name Range
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. NRR S DIR(0)="FO",DIR("B")="FIRST",DIR("A")=" START WITH NAME"
  1. D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1. S:Y="FIRST" Y="A" S IBRF=Y
  1. S DIR(0)="FO",DIR("B")="LAST",DIR("A")=" GO TO NAME"
  1. D ^DIR I ($D(DTOUT))!($D(DUOUT)) S IBQUIT=1 Q
  1. S:Y="LAST" Y="zzzzzz" S IBRL=Y
  1. I $G(IBRL)']$G(IBRF) W !!,?5,"* The Go to Patient Name must follow after the Start with Name. *",! G NRR
  1. Q
  1. ;
  1. QUE ; Ask Device for Excel Output
  1. N %ZIS,ZTRTN,ZTSAVE,ZTDESC
  1. S %ZIS="QM" D ^%ZIS G:POP QUEQ
  1. I $D(IO("Q")) K IO("Q") D G QUEQ
  1. .S ZTRTN="COMPXL^IBCOC1",ZTSAVE("IBRF")="",ZTSAVE("IBRL")=""
  1. .S ZTSAVE("IBBDT")="",ZTSAVE("IBEDT")=""
  1. .S ZTDESC="IB - List New not Verified Policies"
  1. .D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1. ;
  1. U IO
  1. D COMPXL
  1. ;
  1. QUEQ ; Exit clean-up
  1. W ! D ^%ZISC K IBBDT,IBEDT,IBOUT,IBRF,IBRL,VA,VAERR,VADM,VAPA,^TMP("IBCOC1",$J)
  1. Q
  1. ;
  1. COMPXL ; Compile Excel data
  1. ; Input variables:
  1. ; IBRF - Required. Name Range Start value
  1. ; IBRL - Required. Name Range Go To value
  1. ; IBBDT - Required. Begining Entered Date Range
  1. ; IBEDT - Required. Ending Entered Date Range
  1. ;
  1. N IBC,IBCDA,IBCDA0,IBCDA1,IBSSN,IBINS,IBSUBID,IBENDT,IBENUSR,DFN,VA,VADM,VAERR,VAPA
  1. K ^TMP("IBCOC1",$J)
  1. S IBC=0 F S IBC=$O(^DPT("AB",IBC)) Q:'IBC D
  1. .S DFN=0 F S DFN=$O(^DPT("AB",IBC,DFN)) Q:'DFN D
  1. ..K VA,VADM,VAERR,VAPA
  1. ..D DEM^VADPT,ADD^VADPT
  1. ..;
  1. ..; I Pt. name out of range quit
  1. ..S VADM(1)=$P($G(VADM(1)),U,1) I VADM(1)="" Q
  1. ..I VADM(1)]IBRL Q
  1. ..I IBRF]VADM(1) Q
  1. ..;
  1. ..S IBCDA=0 F S IBCDA=$O(^DPT("AB",IBC,DFN,IBCDA)) Q:'IBCDA D
  1. ...S IBCDA0=$$ZND^IBCNS1(DFN,IBCDA) ;516 - baa
  1. ...;
  1. ...; I Verification Date populated quit
  1. ...S IBCDA1=$G(^DPT(DFN,.312,IBCDA,1))
  1. ...I $P(IBCDA1,U,3) Q
  1. ...;
  1. ...; I Entered Date out of range quit
  1. ...I +$P(IBCDA1,U)>IBEDT Q
  1. ...I +$P(IBCDA1,U)<IBBDT Q
  1. ...;
  1. ...; Get data fields
  1. ...S IBSSN=$$GET1^DIQ(2,DFN,.09)
  1. ...S IBINS=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",.01)
  1. ...S IBSUBID=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",7.02)
  1. ...S IBENUSR=$$GET1^DIQ(2.312,IBCDA_","_DFN_",",1.02)
  1. ...S IBENDT=$$FMTE^XLFDT($P(IBCDA1,U),1)
  1. ...;
  1. ...; Set global array
  1. ...S ^TMP("IBCOC1",$J,VADM(1),IBCDA)=VADM(1)_U_IBSSN_U_IBINS_U_IBSUBID_U_IBENUSR_U_IBENDT
  1. ;
  1. ;IB*2.0*602 Add title to Excel Report
  1. W "REPORT OF NEW, NOT VERIFIED INSURANCE ENTRIES FROM: ",$$DAT1^IBOUTL(IBBDT)," TO: ",$$DAT1^IBOUTL(IBEDT)
  1. 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
  1. ; IB*602/HN end
  1. W "PATIENT^PATIENT ID^INSURANCE CO^SUBSCRIBER ID^WHO ENTERED^DATE ENTERED"
  1. I '$D(^TMP("IBCOC1",$J)) W !!,"** NO RECORDS FOUND **" D ASK^IBCOMC2 Q
  1. D WRT,ASK^IBCOMC2
  1. ;
  1. Q
  1. ;
  1. WRT ; Print Excel data
  1. N IBPAT,IBINSTYP
  1. S (IBPAT,IBINSTYP)=""
  1. F S IBPAT=$O(^TMP("IBCOC1",$J,IBPAT)) Q:IBPAT="" D
  1. .F S IBINSTYP=$O(^TMP("IBCOC1",$J,IBPAT,IBINSTYP)) Q:'IBINSTYP W !,^TMP("IBCOC1",$J,IBPAT,IBINSTYP)
  1. Q