IBJTU2 ;ALB/ARH - TPI UTILITIES ;6/6/03 1:05pm
;;2.0;INTEGRATED BILLING;**39,106,199,211,276,435**;21-MAR-94;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
PAT() ; select patient, only allows patient's that have bills - returns DFN^NAME if patient selected, 0 otherwise
N X,Y,DFN,DTOUT,DUOUT,DA
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
S DFN=0,DIC(0)="AEQM",DIC="^DPT(",DIC("S")="I $D(^DGCR(399,""C"",Y))" D ^DIC K DIC I Y'<1 S DFN=Y
Q DFN
;
BILL() ; select bill, returns bill IFN^BILL NUMBER or 0 if none selected
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
N X,Y,DTOUT,DUOUT,DA,IBY S IBY=0,DIC="^DGCR(399,",DIC(0)="AEMQ" D ^DIC K DIC I Y'<1 S IBY=Y
Q IBY
;
PB() ; select either a patient name (must have a bill) or bill number
; if patient chosen: returns "1^"_DFN, if bill chosen: returns "2^"_IBIFN, 0 otherwise
N IBX,IBY,DIC,DTOUT,DUOUT,DA,X,Y,DPTNOFZY,IBSTR
S IBY=0
;
PB1 R !!,"Enter BILL NUMBER or PATIENT NAME: ",IBX:DTIME I IBX["^"!(IBX="") G PBQ
;
I $E(IBX)="?" D G PB1
. W !
. W !," Enter one of following: Patient Name, Bill Number,"
. W !," ECME Number or Prescription Number."
. W !," You may also use prefixes: 'E.' for ECME# or 'R.' for Prescription."
. W !
;
; search for patient name
I IBX?1A4N!(IBX?2A.AP)!(IBX?2.A1",".AP)!(IBX?1A1P.AP) D I IBY G PBQ
. S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
. S DIC="^DPT(",DIC(0)="EQM",DIC("S")="I $D(^DGCR(399,""C"",Y))",X=IBX D ^DIC K DIC I Y'<1 S IBY="1^"_+Y
;
; search for bill number
I (IBX?1A1.12AN)!(IBX?3N1"-"1A1.7AN)!(IBX?1"`"1.15N)!(IBX=" ") D I IBY G PBQ
. S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
. S IBSTR=IBX
. I $L(IBSTR,"-")=2,$P(IBSTR,"-")?3N S IBSTR=$P(IBX,"-",2,255)
. S DIC="^DGCR(399,",DIC(0)="EQ",X=IBSTR D ^DIC K DIC I Y'<1 S IBY="2^"_+Y
;
; search for ECME number REC^IBRFN()
S IBSTR=IBX
I IBSTR?1.12N S IBSTR="E."_IBSTR
I IBSTR?1"E."1.12N S Y=$$REC^IBRFN(IBSTR) I Y>0 S IBY="2^"_+Y G PBQ
;
; search for RX number REC^IBRFN()
S IBSTR=IBX
I IBSTR?1N1.10AN S IBSTR="R."_IBSTR
I IBSTR?1"R."1N1.10AN S Y=$$REC^IBRFN(IBSTR) I Y>0 S IBY="2^"_+Y G PBQ
;
W "??"
G PB1
PBQ Q IBY
;
RCANC(IBIFN,ARR,WDTH) ; if bill cancelled returns ARR = IBIFN ^ PTR TO 200 ^ INITIALS OF WHO CANCELLED IN IB
; ARR(X) = REASON CANCELLED with line width passed in
N X,DIWL,DIWR,DIWF,IBDS,IBCNT,IBI,IBD K ARR
S ARR=0,IBIFN=+$G(IBIFN),IBDS=$G(^DGCR(399,IBIFN,"S"))
S X=$P(IBDS,U,18) G:'X RCANCQ
S ARR=IBIFN_U_X_U_$P($G(^VA(200,+X,0)),U,2)
S X=$P(IBDS,U,19) G:X="" RCANCQ
S DIWL=1,DIWR=$G(WDTH),DIWF="" D ^DIWP
S (IBCNT,IBI)=0,DIWL=1 F S IBI=$O(^UTILITY($J,"W",DIWL,IBI)) Q:'IBI D
. S IBD=$G(^UTILITY($J,"W",DIWL,IBI,0)) I IBD'="" S IBCNT=IBCNT+1,ARR(IBCNT)=IBD
K ^UTILITY($J,"W")
RCANCQ Q
;
DR(DB,DE) ; get a date range from the user, DB is default begin date (FM), DE is default end date
; returns "begin dt ^ end dt" in FM format, or "" if two valid dates are not entered
N IBY,IBX,%DT,X,Y S (IBX,IBY)="" I $G(DB)?7N S %DT("B")=$$FMTE^XLFDT(DB,2)
S %DT="AEX",%DT("A")="Start Date: " D ^%DT K %DT G:Y<0 DRQ S IBX=Y
S %DT(0)=IBX,%DT("B")=$$FMTE^XLFDT($S(IBX>$G(DE):IBX,1:DE),2)
S %DT="AEX",%DT("A")="End Date: " D ^%DT K %DT G:Y<0 DRQ S IBY=IBX_U_Y
DRQ Q IBY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTU2 3390 printed Apr 09, 2024@21:20:33 Page 2
IBJTU2 ;ALB/ARH - TPI UTILITIES ;6/6/03 1:05pm
+1 ;;2.0;INTEGRATED BILLING;**39,106,199,211,276,435**;21-MAR-94;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
PAT() ; select patient, only allows patient's that have bills - returns DFN^NAME if patient selected, 0 otherwise
+1 NEW X,Y,DFN,DTOUT,DUOUT,DA
+2 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+3 SET DFN=0
SET DIC(0)="AEQM"
SET DIC="^DPT("
SET DIC("S")="I $D(^DGCR(399,""C"",Y))"
DO ^DIC
KILL DIC
IF Y'<1
SET DFN=Y
+4 QUIT DFN
+5 ;
BILL() ; select bill, returns bill IFN^BILL NUMBER or 0 if none selected
+1 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+2 NEW X,Y,DTOUT,DUOUT,DA,IBY
SET IBY=0
SET DIC="^DGCR(399,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
IF Y'<1
SET IBY=Y
+3 QUIT IBY
+4 ;
PB() ; select either a patient name (must have a bill) or bill number
+1 ; if patient chosen: returns "1^"_DFN, if bill chosen: returns "2^"_IBIFN, 0 otherwise
+2 NEW IBX,IBY,DIC,DTOUT,DUOUT,DA,X,Y,DPTNOFZY,IBSTR
+3 SET IBY=0
+4 ;
PB1 READ !!,"Enter BILL NUMBER or PATIENT NAME: ",IBX:DTIME
IF IBX["^"!(IBX="")
GOTO PBQ
+1 ;
+2 IF $EXTRACT(IBX)="?"
Begin DoDot:1
+3 WRITE !
+4 WRITE !," Enter one of following: Patient Name, Bill Number,"
+5 WRITE !," ECME Number or Prescription Number."
+6 WRITE !," You may also use prefixes: 'E.' for ECME# or 'R.' for Prescription."
+7 WRITE !
End DoDot:1
GOTO PB1
+8 ;
+9 ; search for patient name
+10 IF IBX?1A4N!(IBX?2A.AP)!(IBX?2.A1",".AP)!(IBX?1A1P.AP)
Begin DoDot:1
+11 ;Suppress PATIENT file fuzzy lookups
SET DPTNOFZY=1
+12 SET DIC="^DPT("
SET DIC(0)="EQM"
SET DIC("S")="I $D(^DGCR(399,""C"",Y))"
SET X=IBX
DO ^DIC
KILL DIC
IF Y'<1
SET IBY="1^"_+Y
End DoDot:1
IF IBY
GOTO PBQ
+13 ;
+14 ; search for bill number
+15 IF (IBX?1A1.12AN)!(IBX?3N1"-"1A1.7AN)!(IBX?1"`"1.15N)!(IBX=" ")
Begin DoDot:1
+16 ;Suppress PATIENT file fuzzy lookups
SET DPTNOFZY=1
+17 SET IBSTR=IBX
+18 IF $LENGTH(IBSTR,"-")=2
IF $PIECE(IBSTR,"-")?3N
SET IBSTR=$PIECE(IBX,"-",2,255)
+19 SET DIC="^DGCR(399,"
SET DIC(0)="EQ"
SET X=IBSTR
DO ^DIC
KILL DIC
IF Y'<1
SET IBY="2^"_+Y
End DoDot:1
IF IBY
GOTO PBQ
+20 ;
+21 ; search for ECME number REC^IBRFN()
+22 SET IBSTR=IBX
+23 IF IBSTR?1.12N
SET IBSTR="E."_IBSTR
+24 IF IBSTR?1"E."1.12N
SET Y=$$REC^IBRFN(IBSTR)
IF Y>0
SET IBY="2^"_+Y
GOTO PBQ
+25 ;
+26 ; search for RX number REC^IBRFN()
+27 SET IBSTR=IBX
+28 IF IBSTR?1N1.10AN
SET IBSTR="R."_IBSTR
+29 IF IBSTR?1"R."1N1.10AN
SET Y=$$REC^IBRFN(IBSTR)
IF Y>0
SET IBY="2^"_+Y
GOTO PBQ
+30 ;
+31 WRITE "??"
+32 GOTO PB1
PBQ QUIT IBY
+1 ;
RCANC(IBIFN,ARR,WDTH) ; if bill cancelled returns ARR = IBIFN ^ PTR TO 200 ^ INITIALS OF WHO CANCELLED IN IB
+1 ; ARR(X) = REASON CANCELLED with line width passed in
+2 NEW X,DIWL,DIWR,DIWF,IBDS,IBCNT,IBI,IBD
KILL ARR
+3 SET ARR=0
SET IBIFN=+$GET(IBIFN)
SET IBDS=$GET(^DGCR(399,IBIFN,"S"))
+4 SET X=$PIECE(IBDS,U,18)
if 'X
GOTO RCANCQ
+5 SET ARR=IBIFN_U_X_U_$PIECE($GET(^VA(200,+X,0)),U,2)
+6 SET X=$PIECE(IBDS,U,19)
if X=""
GOTO RCANCQ
+7 SET DIWL=1
SET DIWR=$GET(WDTH)
SET DIWF=""
DO ^DIWP
+8 SET (IBCNT,IBI)=0
SET DIWL=1
FOR
SET IBI=$ORDER(^UTILITY($JOB,"W",DIWL,IBI))
if 'IBI
QUIT
Begin DoDot:1
+9 SET IBD=$GET(^UTILITY($JOB,"W",DIWL,IBI,0))
IF IBD'=""
SET IBCNT=IBCNT+1
SET ARR(IBCNT)=IBD
End DoDot:1
+10 KILL ^UTILITY($JOB,"W")
RCANCQ QUIT
+1 ;
DR(DB,DE) ; get a date range from the user, DB is default begin date (FM), DE is default end date
+1 ; returns "begin dt ^ end dt" in FM format, or "" if two valid dates are not entered
+2 NEW IBY,IBX,%DT,X,Y
SET (IBX,IBY)=""
IF $GET(DB)?7N
SET %DT("B")=$$FMTE^XLFDT(DB,2)
+3 SET %DT="AEX"
SET %DT("A")="Start Date: "
DO ^%DT
KILL %DT
if Y<0
GOTO DRQ
SET IBX=Y
+4 SET %DT(0)=IBX
SET %DT("B")=$$FMTE^XLFDT($SELECT(IBX>$GET(DE):IBX,1:DE),2)
+5 SET %DT="AEX"
SET %DT("A")="End Date: "
DO ^%DT
KILL %DT
if Y<0
GOTO DRQ
SET IBY=IBX_U_Y
DRQ QUIT IBY
