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

IBNCPDPE.m

Go to the documentation of this file.
  1. IBNCPDPE ;DALOI/AAT - NCPDP BILLING EVENTS REPORT ;3/6/08 16:18
  1. ;;2.0;INTEGRATED BILLING;**276,342,347,363,384,435**;21-MAR-94;Build 27
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; Reference to $$MULTPHRM^BPSUTIL supported by IA# 4146
  1. ; Reference to DIC^PSODI supported by IA# 4858
  1. ;
  1. DATE ;
  1. S (IBBDT,IBEDT)=DT
  1. S %DT="AEX"
  1. S %DT("A")="START WITH DATE: ",%DT("B")="TODAY"
  1. D ^%DT K %DT
  1. I Y<0 S IBQ=1 Q
  1. S IBBDT=+Y
  1. S %DT="AEX"
  1. S %DT("A")="GO TO DATE: ",%DT("B")="TODAY"
  1. D ^%DT K %DT
  1. I Y<0 S IBQ=1 Q
  1. S IBEDT=+Y
  1. Q
  1. ;
  1. MODE ;
  1. N DIR,DIC,DIRUT,DUOUT,PSOFILE
  1. S (IBM1,IBM2,IBM3)="A"
  1. S DIR(0)="S^P:SINGLE PATIENT;R:SINGLE RX;E:SINGLE ECME #;A:ALL ACTIVITY"
  1. S DIR("A")="SINGLE (P)ATIENT, SINGLE (R)X, SINGLE (E)CME #, (A)LL ACTIVITY"
  1. S DIR("B")="ALL"
  1. D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q
  1. S IBM1=Y
  1. I IBM1="P" S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC Q:$D(DUOUT) S IBPAT=$S(Y>0:+Y,1:0) I 'IBPAT W " ALL" S IBM1="A"
  1. I IBM1="R" S PSOFILE=52,DIC="^PSRX(",DIC(0)="AEQMN" D DIC^PSODI(PSOFILE,.DIC) Q:$D(DUOUT) S IBRX=$S(Y>0:+Y,1:0) I 'IBRX W " ALL" S IBM1="A"
  1. K PSODIY
  1. I IBM1="E" S DIR(0)="FO^1:12^I X'?1.12N W !!,""Cannot contain alpha characters"" K X",DIR("A")="Enter ECME #" D ^DIR Q:$D(DUOUT) S IBECME=$S(+Y>0:Y,1:0) I 'IBECME W " ALL" S IBM1="A"
  1. S IBM2="B"
  1. ; if "All"
  1. I IBM1="A" D Q:$G(IBQ)
  1. .S DIR(0)="S^E:ECME BILLABLE;N:NON ECME BILLABLE;B:BOTH"
  1. .S DIR("A")="(E)CME BILLABLE;(N)ON ECME BILLABLE;(B)OTH"
  1. .S DIR("B")="BOTH"
  1. .D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q
  1. .S IBM2=Y
  1. ;
  1. ;Mail/Window/CMOP?
  1. S DIR(0)="S^M:MAIL;W:WINDOW;C:CMOP;A:ALL"
  1. S DIR("A")="(M)AIL, (W)INDOW, (C)CMOP, (A)LL"
  1. S DIR("B")="ALL"
  1. D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q
  1. S IBM3=Y
  1. ;
  1. S DIR(0)="S^S:SUMMARY REPORT;D:DETAILED REPORT"
  1. S DIR("A")="(S)UMMARY REPORT, (D)ETAILED REPORT"
  1. S DIR("B")="SUMMARY REPORT"
  1. D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q
  1. S IBDTL=($E(Y)="D")
  1. Q
  1. ;
  1. TESTDATA() ;
  1. N Y
  1. S Y=$$HAVEDATA()
  1. I 'Y W !!,"No data found in the specified period.",!
  1. Q Y
  1. ;
  1. HAVEDATA() ;
  1. N Z
  1. I $D(^IBCNR(366.14,"B",IBBDT)) Q 1
  1. S Z=+$O(^IBCNR(366.14,"B",IBBDT))
  1. I Z=0 Q 0
  1. I Z>IBEDT Q 0
  1. Q 1
  1. ;
  1. DEVICE ;
  1. N DIR,DIRUT,POP,ZTRTN,ZTIO,ZTSAVE,ZTDESC,%ZIS,ZTSK
  1. S %ZIS="QM"
  1. W ! D ^%ZIS
  1. I POP S IBQ=1 Q
  1. S IBSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. ;
  1. I $D(IO("Q")) D S IBQ=1
  1. . S ZTRTN="START^IBNCPEV"
  1. . S ZTIO=ION
  1. . S ZTSAVE("IB*")=""
  1. . S ZTDESC="IB ECME BILLING EVENTS REPORT"
  1. . D ^%ZTLOAD
  1. . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. . D HOME^%ZIS
  1. U IO
  1. Q
  1. ;------ added for the User screen --------
  1. ;User Screen Entry point (to call from ECME User Screen)
  1. ;IBMODE:
  1. ; P-patient
  1. ; R-Rx
  1. ;IBVAL - patient DFN or RX ien (#52)
  1. ;
  1. USRSCREN(IBMODE,IBVAL) ;
  1. N IBPAT,IBRX,IBBDT,IBEDT,Y,IBM1,IBM2,IBM3,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS
  1. S (IBPAT,IBRX,IBQ,IBSCR,IBPAGE,IBDTL,IBDIVS)=0
  1. S IBM1=IBMODE
  1. I IBM1="P" S IBPAT=+IBVAL
  1. I IBM1="R" S IBRX=+IBVAL
  1. ;date
  1. F D DATE Q:IBQ Q:$$TESTDATA
  1. Q:IBQ
  1. N IBMLTDV S IBMLTDV=$$MULTPHRM^BPSUTIL()
  1. I +IBMLTDV=1 S IBDIVS=+$$MULTIDIV^IBNCPEV1(.IBDIVS) S:IBDIVS=0 IBDIVS(0)="0^ALL" I IBDIVS=-1 S IBQ=1 Q
  1. I +IBMLTDV=0 S IBDIVS=0,IBDIVS(0)="0^"_$P(IBMLTDV,U,2)
  1. D MODE2 Q:IBQ
  1. D DEVICE Q:IBQ
  1. D START^IBNCPEV
  1. D ^%ZISC
  1. I IBQ W !,"Cancelled"
  1. Q
  1. ;
  1. MODE2 ;
  1. N DIR,DIC,DIRUT,DUOUT
  1. S (IBM1,IBM2,IBM3)="A"
  1. S IBM2="B"
  1. ;
  1. ;Mail/Window/CMOP?
  1. S DIR(0)="S^M:MAIL;W:WINDOW;C:CMOP;A:ALL"
  1. S DIR("A")="(M)AIL, (W)INDOW, (C)CMOP, (A)LL"
  1. S DIR("B")="ALL"
  1. D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q
  1. S IBM3=Y
  1. ;
  1. S DIR(0)="S^S:SUMMARY REPORT;D:DETAILED REPORT"
  1. S DIR("A")="(S)UMMARY REPORT, (D)ETAILED REPORT"
  1. S DIR("B")="SUMMARY REPORT"
  1. D ^DIR K DIR I $D(DIRUT) S IBQ=1 Q
  1. S IBDTL=($E(Y)="D")
  1. Q
  1. ;IBNCPDPE