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

IBCSC10B.m

Go to the documentation of this file. 
  1. IBCSC10B ;BP/YMG - ADD/ENTER PATIENT REASON FOR VISIT DATA ;10/15/2008
  1.  ;;2.0;INTEGRATED BILLING;**432,461**;21-MAR-94;Build 58
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; DEM;432 - Moved IBCSC8* billing screen routines to IBCSC10* billing screen
  1.  ;           routines and created a new billing screen 8 routine IBCSC8.
  1.  ;
  1. EN ; entry point
  1.  N DATE,DATE1,DFN,I,IBDX,IBLIST,LOC,PRV0,PRVIEN,PRVS,SCREEN,TCNT,TMP,VCNT,VISITS
  1.  D:$$CHKPRV<3 DELALL(IBIFN)
  1.  ; only try to fetch PRVs if Quadramed file (19640.11) exists
  1.  I $D(^DSIPPRV) D
  1.  .S DFN=$P(^DGCR(399,IBIFN,0),U,2)
  1.  .; try to get all visits for OP Visit dates on the claim
  1.  .;
  1.  .; use only the date portion of date&time field in VISIT file for screening
  1.  .; if OP Visit field contains only a month, only compare month and year
  1.  .S SCREEN="N Z S Z=$P($P(^(0),U),""."") S:'+$E(DATE,6,7) Z=$E(Z,1,5) I Z=DATE"
  1.  .S DATE=0,VCNT=1 F  S DATE=$O(^DGCR(399,IBIFN,"OP",DATE)) Q:'DATE  D
  1.  ..D FIND^DIC(9000010,,"@;.01I","QPX",DFN,,"C",SCREEN,,"TMP") Q:'$P(TMP("DILIST",0),U)
  1.  ..S TCNT=0 F  S TCNT=$O(TMP("DILIST",TCNT)) Q:'TCNT  S VISITS(VCNT)=$P(TMP("DILIST",TCNT,0),U),VCNT=VCNT+1
  1.  ..Q
  1.  .I '$D(VISITS) D
  1.  ..; couldn't find anything for OP Visit dates (or there are no OP Visit dates on the claim)
  1.  ..; try to use Statement Covers From and Statement Covers To fields instead
  1.  ..S DATE=$P($G(^DGCR(399,IBIFN,"U")),U) Q:'DATE  ;
  1.  ..S DATE1=$P($G(^DGCR(399,IBIFN,"U")),U,2) Q:'DATE1  ;
  1.  ..S SCREEN="N Z S Z=$P($P(^(0),U),""."") I Z>=DATE&(Z<=DATE1)"
  1.  ..D FIND^DIC(9000010,,"@;.01I","QPX",DFN,,"C",SCREEN,,"TMP") Q:'$P(TMP("DILIST",0),U)
  1.  ..S TCNT=0,VCNT=1 F  S TCNT=$O(TMP("DILIST",TCNT)) Q:'TCNT  S VISITS(VCNT)=$P(TMP("DILIST",TCNT,0),U),VCNT=VCNT+1
  1.  ..Q
  1.  .I $D(VISITS) D
  1.  ..; we have found some visits, try to fetch corresponding PRVs from file 19640.11 into PRVS array
  1.  ..; PRVS node structure: PRV dx ien ^ hospital location ^ visit date&time
  1.  ..S TCNT=1,VCNT=0 F  S VCNT=$O(VISITS(VCNT)) Q:'VCNT  D
  1.  ...S PRVIEN=$O(^DSIPPRV("B",VISITS(VCNT),"")) Q:'PRVIEN
  1.  ...S PRV0=$G(^DSIPPRV(PRVIEN,0))
  1.  ...S LOC=$$GET1^DIQ(9000010,VISITS(VCNT),.22)
  1.  ...S DATE=$$GET1^DIQ(9000010,VISITS(VCNT),.01)
  1.  ...F I=2:1:4 I $P(PRV0,U,I)'="" S PRVS(TCNT)=$P(PRV0,U,I)_U_LOC_U_DATE,TCNT=TCNT+1
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  D DISP D:+$G(TCNT)>0 NEWDX(TCNT-1) I $D(IBLIST) D ADDNEW
  1.  D DISPEX(IBIFN)
  1.  D CLEAN^DILF
  1. EN1 ;
  1.  S IBDX=$$ASKDX I +IBDX>0 D ADD($P(IBDX,U)),EDIT(+IBDX) G EN1
  1.  Q
  1.  ;
  1. DISP ; display PRV diagnoses
  1.  N CNT,DXCODE,I,IBDX,PRV
  1.  W @IOF,!,"===================Pt. Reason for Visit Diagnosis Screen ====================",!
  1.  I '$D(PRVS) W !,?13,"No available Pt. Reason for Visit Diagnoses found." Q
  1.  S CNT=0 F  S CNT=$O(PRVS(CNT)) Q:'CNT  D
  1.  .S IBDX=$$ICD9^IBACSV($P(PRVS(CNT),U),$$BDATE^IBACSV(IBIFN)),DXCODE=$P(IBDX,U)
  1.  .F I=8:1:10 S PRV=$P($G(^DGCR(399,IBIFN,"U3")),U,I) I PRV=+PRVS(CNT) S DXCODE="*"_DXCODE Q
  1.  .W !,$J(CNT,2),")",?4,DXCODE,?15,$E($P(IBDX,U,3),1,30),?46,$E($P(PRVS(CNT),U,2),1,14),?62,$P(PRVS(CNT),U,3)
  1.  .Q
  1.  Q
  1.  ;
  1. DISPEX(IBIFN) ; display existing PRV diagnoses for a bill
  1.  N I,IBDX,IBDXDT
  1.  W !!,?5,"------  Existing Pt. Reason for Visit Diagnoses for Bill  -------",!
  1.  F I=8:1:10 S IBDX=$P($G(^DGCR(399,IBIFN,"U3")),U,I) I IBDX'="" D
  1.  .S IBDXDT=$$ICD9^IBACSV(IBDX,$$BDATE^IBACSV(IBIFN))
  1.  .W !,?5,$P(IBDXDT,U),?17,$P(IBDXDT,U,3)
  1.  ;
  1.  W:$G(IBDXDT)="" !,?13,"No existing Pt. Reason for Visit Diagnoses found."
  1.  W !
  1.  Q
  1.  ;
  1. CHKPRV() ; check how many PRVs are not populated (out of 3)
  1.  N CNT,I
  1.  S CNT=3 F I=8:1:10 I $P($G(^DGCR(399,IBIFN,"U3")),U,I)'="" S CNT=CNT-1
  1.  Q CNT
  1.  ;
  1. PRVFLD(DXIEN) ; returns the field number that contains DXIEN
  1.  ; if DXIEN="", returns the first empty PRV field number
  1.  ; if no match found (or no empty fields), returns 0
  1.  N I,FLD
  1.  S FLD=0 F I=8:1:10 I $P($G(^DGCR(399,IBIFN,"U3")),U,I)=DXIEN S FLD=I+241 Q
  1.  Q FLD
  1.  ;
  1. ERR ; display error message
  1.  W !,?6,"You may add a maximum of 3 PRV diagnoses to a claim."
  1.  Q
  1.  ;
  1. NEWDX(IBX) ; select PRV diagnosis to add to bill
  1.  ; IBX - max. number of PRV diagnoses available
  1.  N X,Y,DIR,DIRUT
  1.  Q:'IBX!('$$CHKPRV)  ;
  1.  W !
  1. NEWDX1 S DIR("?",1)="Enter the number preceding the PRV diagnosis you want added to the bill.",DIR("?")="Multiple entries may be added separated by commas or ranges separated by a dash."
  1.  S DIR("A")="Select Pt. Reason for Visit Diagnosis to add to bill"
  1.  S DIR(0)="LO^1:"_+IBX D ^DIR K DIR G:'Y!$D(DIRUT) NEWDXE
  1.  S IBLIST=Y
  1.  S DIR("A")="You have selected "_IBLIST_" to be added to the bill. Is this correct",DIR("B")="YES"
  1.  S DIR(0)="YO" D ^DIR K DIR I $D(DIRUT) K IBLIST G NEWDXE
  1.  I 'Y G NEWDX1
  1.  I $L(IBLIST,",")-1>$$CHKPRV D ERR G NEWDX1
  1. NEWDXE Q
  1.  ;
  1. ADD(DXIEN) ; add single PRV diagnosis with file 80 ien DXIEN to the bill
  1.  Q:'DXIEN!$$PRVFLD(DXIEN)  ; quit if no dx ien or if such PRV already exists
  1.  N FLD
  1.  ; if there are already 3 PRVs on the claim, complain and bail out
  1.  I '$$CHKPRV D ERR Q
  1.  S FLD=$$PRVFLD("") I FLD S DIE="^DGCR(399,",DA=IBIFN,DR=FLD_"////"_DXIEN D ^DIE K DA,DIE
  1.  Q
  1.  ;
  1. ADDNEW ; add selected PRV diagnoses to the bill
  1.  Q:'$D(PRVS)
  1.  N I,IBX
  1.  F I=1:1 S IBX=$P(IBLIST,",",I) Q:'IBX  I $D(PRVS(IBX)) D ADD(+PRVS(IBX))
  1.  Q
  1.  ;
  1. ASKDX() ; enter extra PRV diagnosis
  1.  ; returns dx ien in file 80 ^ dx code
  1.  N X,Y,IBDATE,IBDTTX,ICDVDT
  1.  S IBDATE=$$BDATE^IBACSV(IBIFN),ICDVDT=IBDATE
  1.  S IBDTTX=$$DAT1^IBOUTL(IBDATE)
  1.  S DIR("?")="Enter a diagnosis for this bill. Only diagnosis codes active on "_IBDTTX_" are allowed."
  1.  S DIR("S")="I $$ICD9VER^IBACSV(+Y)="_$$ICD9SYS^IBACSV(IBDATE) ; inactive allowed but either ICD-9 or ICD-10 *461
  1.  S DIR(0)="PO^80:EAMQI",DIR("A")="Enter Pt. Reason for Visit Diagnosis"
  1.  D ^DIR K DIR
  1.  I Y>0,'$$PRVFLD(+Y),'$$ICD9ACT^IBACSV(+Y,IBDATE) D  G AD
  1.  . W !!,*7,"The Diagnosis code is inactive for the date of service ("_IBDTTX_").",!
  1.  Q Y
  1.  ;
  1. EDIT(DXIEN) ; edit/delete PRV diagnosis
  1.  N IBU3,FLD,PRV2,PRV3
  1.  Q:'DXIEN  S FLD=$$PRVFLD(DXIEN) I FLD S DIE="^DGCR(399,",DA=IBIFN,DR=FLD D ^DIE K DIE,DR,DA
  1.  ; if PRV was deleted, rearrange PRVs to maintain their order of entry
  1.  S IBU3=$G(^DGCR(399,IBIFN,"U3")) I $P(IBU3,U,FLD-241)="" D
  1.  .; PRV(1) was deleted, PRV(2) is not empty
  1.  .I FLD=249 S PRV2=$P(IBU3,U,9) S:PRV2'="" PRV3=$P(IBU3,U,10),DR="249////"_PRV2_";"_$S(PRV3'="":"250////"_PRV3_";251///@",1:"250///@")
  1.  .; PRV(2) was deleted, PRV(3) is not empty
  1.  .I FLD=250 S PRV3=$P(IBU3,U,10) I PRV3'="" S DR="250////"_PRV3_";251///@"
  1.  .; if PRV(3) is deleted, no rearrangements are necessary
  1.  .Q
  1.  I $G(DR)'="" S DIE="^DGCR(399,",DA=IBIFN D ^DIE K DIE,DR,DA
  1.  Q
  1.  ;
  1. DELALL(IBIFN) ; ask/delete all PRV diagnoses on the bill
  1.  N DIE,DA,DR,DIR,DIRUT,DUOUT,DTOUT,X,Y W !
  1.  S DIR("?")="Enter Yes to delete all PRV diagnoses currently defined for a bill.",DIR("??")="^D DISPEX^IBCSC10B("_IBIFN_")"
  1.  S DIR("A")="Delete all Patient Reason for Visit diagnoses on bill"
  1.  S DIR(0)="YO",DIR("B")="NO" D ^DIR K DIR Q:Y'=1
  1.  ;
  1.  S DIE="^DGCR(399,",DA=IBIFN,DR="249///@;250///@;251///@" D ^DIE
  1.  W " .... deleted"
  1.  Q