IBECUSMU ;ALB/CPM - PHARMACY BILLING OPTION UTILITIES ; 12-DEC-96
;;2.0;INTEGRATED BILLING;**52,347**;21-MAR-94;Build 24
;
;
FINDC(IBIN,IBW,IBOUT) ; Find transactions which can be cancelled.
; Input: IBIN -- Array of transactions, passed by reference
; IBW -- 1 => Write reject statements
; 2 => No writes
; Output: IBOUT -- Array of transactions which can be cancelled
;
N IBKEY,IBCHTRN,IBCHTRN5,IBCHTRN6
S IBKEY="" F S IBKEY=$O(IBIN(IBKEY)) Q:IBKEY="" D
.S IBCHTRN=IBIN(IBKEY)
.S IBCHTRN5=$G(^IBA(351.5,IBCHTRN,5)),IBCHTRN6=$G(^(6))
.;
.; - can cancel if original transmission was billed
.; (no billing rejects) without trying to cancel
.; (no cancel auth) or if the cancel was rejected
.I IBCHTRN5="",IBCHTRN6=""!($P(IBCHTRN6,"^",3)'="") S IBOUT(IBKEY)=IBCHTRN Q
.;
.; - write error messages
.Q:'$G(IBW)
.;
.; - billing transaction was rejected
.I IBCHTRN5]"" W !," The claim for ",$S($P(IBKEY,";",2):"refill #"_$P(IBKEY,";",2),1:"the original fill")," for this prescription was rejected." Q
.;
.; - transaction was cancelled
.W !?1,$S($P(IBKEY,";",2):"Refill #"_$P(IBKEY,";",2),1:"The original fill")," for this prescription has already been reversed."
;
Q
;
;
FINDB(IBRX,IBW,IBOUT) ; Find prescriptions which can be billed.
; Input: IBRX -- Pointer to the prescription in file #52
; IBW -- 1 => Write reject statements
; 2 => No writes
; Output: IBOUT -- Array of transactions which can be billed
;
N IBARR,IBREF,IBKEY,IBCHTRN,IBCHTRN5,IBCHTRN6,IBREF1,LIST
S LIST="FINDBLIST"
;
; - build potential array from prescription (#52) file
S IBARR(IBRX_";0")=$O(^IBA(351.5,"B",IBRX_";0",0))
S IBREF=0
D RX^PSO52API($$FILE^IBRXUTL(IBRX,2),LIST,IBRX,,"R^^",,)
S IBREF=0 F S IBREF=$O(^TMP($J,LIST,$$FILE^IBRXUTL(IBRX,2),IBRX,"RF",IBREF)) Q:IBREF'>0 D
.Q:'IBREF
.S IBARR(IBRX_";"_IBREF)=$O(^IBA(351.5,"B",IBRX_";"_IBREF,0))
;
K ^TMP($J,LIST)
S IBKEY="" F S IBKEY=$O(IBARR(IBKEY)) Q:IBKEY="" D
.S IBCHTRN=IBARR(IBKEY)
.I 'IBCHTRN S IBOUT(IBKEY)=IBCHTRN Q
.;
.S IBCHTRN5=$G(^IBA(351.5,IBCHTRN,5)),IBCHTRN6=$G(^(6))
.;
.; - can bill if original transmission was rejected,
.; or if that transmission was cancelled (re-submit)
.I IBCHTRN5]""!(IBCHTRN5=""&($P(IBCHTRN6,"^")'="")) S IBOUT(IBKEY)=IBCHTRN Q
.;
.; - write messages
.Q:'$G(IBW)
.;
.; - already billed (previous cancellation was rejected)
.I $P(IBCHTRN6,"^",3)'="" W !!," The previous cancellation for ",$S($P(IBKEY,";",2):"refill #"_$P(IBKEY,";",2),1:"the original fill")," was rejected." Q
.;
.; - never tried to cancel
.W !!?1,$S($P(IBKEY,";",2):"Refill #"_$P(IBKEY,";",2),1:"The original fill")," for this prescription has already been billed."
;
Q
;
;
SEL(IBARR) ; Select a fill for a prescription.
; Input: IBARR -- Array of prescriptions passed by reference.
; Output: IBNUM -- One of the fill numbers, or -1 (none selected)
;
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,IBSTR,IBKEY,IBRX,IBREF,IBFILL,IBNUM
;
; - build string for DIR(0)
S (IBSTR,IBKEY)="",IBNUM=-1
F S IBKEY=$O(IBARR(IBKEY)) Q:IBKEY="" D
.S IBRX=+IBKEY,IBREF=+$P(IBKEY,";",2)
.S IBFILL=$S(IBREF:+$$SUBFILE^IBRXUTL(IBRX,IBREF,52,.01),1:+$$FILE^IBRXUTL(IBRX,22))
.S IBSTR=IBSTR_IBREF_":"_$S(IBREF:"Refill #"_IBREF,1:"Original Fill")_" (filled "_$$DAT1^IBOUTL(IBFILL)_");"
;
I IBSTR="" G SELQ
;
S DIR("A")="Select one of the fills by number",DIR(0)="S^"_IBSTR
D ^DIR I $D(DUOUT)!$D(DIROUT)!$D(DTOUT) G SELQ
;
S IBNUM=Y
;
SELQ Q IBNUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBECUSMU 3643 printed Apr 09, 2024@21:06:33 Page 2
IBECUSMU ;ALB/CPM - PHARMACY BILLING OPTION UTILITIES ; 12-DEC-96
+1 ;;2.0;INTEGRATED BILLING;**52,347**;21-MAR-94;Build 24
+2 ;
+3 ;
FINDC(IBIN,IBW,IBOUT) ; Find transactions which can be cancelled.
+1 ; Input: IBIN -- Array of transactions, passed by reference
+2 ; IBW -- 1 => Write reject statements
+3 ; 2 => No writes
+4 ; Output: IBOUT -- Array of transactions which can be cancelled
+5 ;
+6 NEW IBKEY,IBCHTRN,IBCHTRN5,IBCHTRN6
+7 SET IBKEY=""
FOR
SET IBKEY=$ORDER(IBIN(IBKEY))
if IBKEY=""
QUIT
Begin DoDot:1
+8 SET IBCHTRN=IBIN(IBKEY)
+9 SET IBCHTRN5=$GET(^IBA(351.5,IBCHTRN,5))
SET IBCHTRN6=$GET(^(6))
+10 ;
+11 ; - can cancel if original transmission was billed
+12 ; (no billing rejects) without trying to cancel
+13 ; (no cancel auth) or if the cancel was rejected
+14 IF IBCHTRN5=""
IF IBCHTRN6=""!($PIECE(IBCHTRN6,"^",3)'="")
SET IBOUT(IBKEY)=IBCHTRN
QUIT
+15 ;
+16 ; - write error messages
+17 if '$GET(IBW)
QUIT
+18 ;
+19 ; - billing transaction was rejected
+20 IF IBCHTRN5]""
WRITE !," The claim for ",$SELECT($PIECE(IBKEY,";",2):"refill #"_$PIECE(IBKEY,";",2),1:"the original fill")," for this prescription was rejected."
QUIT
+21 ;
+22 ; - transaction was cancelled
+23 WRITE !?1,$SELECT($PIECE(IBKEY,";",2):"Refill #"_$PIECE(IBKEY,";",2),1:"The original fill")," for this prescription has already been reversed."
End DoDot:1
+24 ;
+25 QUIT
+26 ;
+27 ;
FINDB(IBRX,IBW,IBOUT) ; Find prescriptions which can be billed.
+1 ; Input: IBRX -- Pointer to the prescription in file #52
+2 ; IBW -- 1 => Write reject statements
+3 ; 2 => No writes
+4 ; Output: IBOUT -- Array of transactions which can be billed
+5 ;
+6 NEW IBARR,IBREF,IBKEY,IBCHTRN,IBCHTRN5,IBCHTRN6,IBREF1,LIST
+7 SET LIST="FINDBLIST"
+8 ;
+9 ; - build potential array from prescription (#52) file
+10 SET IBARR(IBRX_";0")=$ORDER(^IBA(351.5,"B",IBRX_";0",0))
+11 SET IBREF=0
+12 DO RX^PSO52API($$FILE^IBRXUTL(IBRX,2),LIST,IBRX,,"R^^",,)
+13 SET IBREF=0
FOR
SET IBREF=$ORDER(^TMP($JOB,LIST,$$FILE^IBRXUTL(IBRX,2),IBRX,"RF",IBREF))
if IBREF'>0
QUIT
Begin DoDot:1
+14 if 'IBREF
QUIT
+15 SET IBARR(IBRX_";"_IBREF)=$ORDER(^IBA(351.5,"B",IBRX_";"_IBREF,0))
End DoDot:1
+16 ;
+17 KILL ^TMP($JOB,LIST)
+18 SET IBKEY=""
FOR
SET IBKEY=$ORDER(IBARR(IBKEY))
if IBKEY=""
QUIT
Begin DoDot:1
+19 SET IBCHTRN=IBARR(IBKEY)
+20 IF 'IBCHTRN
SET IBOUT(IBKEY)=IBCHTRN
QUIT
+21 ;
+22 SET IBCHTRN5=$GET(^IBA(351.5,IBCHTRN,5))
SET IBCHTRN6=$GET(^(6))
+23 ;
+24 ; - can bill if original transmission was rejected,
+25 ; or if that transmission was cancelled (re-submit)
+26 IF IBCHTRN5]""!(IBCHTRN5=""&($PIECE(IBCHTRN6,"^")'=""))
SET IBOUT(IBKEY)=IBCHTRN
QUIT
+27 ;
+28 ; - write messages
+29 if '$GET(IBW)
QUIT
+30 ;
+31 ; - already billed (previous cancellation was rejected)
+32 IF $PIECE(IBCHTRN6,"^",3)'=""
WRITE !!," The previous cancellation for ",$SELECT($PIECE(IBKEY,";",2):"refill #"_$PIECE(IBKEY,";",2),1:"the original fill")," was rejected."
QUIT
+33 ;
+34 ; - never tried to cancel
+35 WRITE !!?1,$SELECT($PIECE(IBKEY,";",2):"Refill #"_$PIECE(IBKEY,";",2),1:"The original fill")," for this prescription has already been billed."
End DoDot:1
+36 ;
+37 QUIT
+38 ;
+39 ;
SEL(IBARR) ; Select a fill for a prescription.
+1 ; Input: IBARR -- Array of prescriptions passed by reference.
+2 ; Output: IBNUM -- One of the fill numbers, or -1 (none selected)
+3 ;
+4 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,IBSTR,IBKEY,IBRX,IBREF,IBFILL,IBNUM
+5 ;
+6 ; - build string for DIR(0)
+7 SET (IBSTR,IBKEY)=""
SET IBNUM=-1
+8 FOR
SET IBKEY=$ORDER(IBARR(IBKEY))
if IBKEY=""
QUIT
Begin DoDot:1
+9 SET IBRX=+IBKEY
SET IBREF=+$PIECE(IBKEY,";",2)
+10 SET IBFILL=$SELECT(IBREF:+$$SUBFILE^IBRXUTL(IBRX,IBREF,52,.01),1:+$$FILE^IBRXUTL(IBRX,22))
+11 SET IBSTR=IBSTR_IBREF_":"_$SELECT(IBREF:"Refill #"_IBREF,1:"Original Fill")_" (filled "_$$DAT1^IBOUTL(IBFILL)_");"
End DoDot:1
+12 ;
+13 IF IBSTR=""
GOTO SELQ
+14 ;
+15 SET DIR("A")="Select one of the fills by number"
SET DIR(0)="S^"_IBSTR
+16 DO ^DIR
IF $DATA(DUOUT)!$DATA(DIROUT)!$DATA(DTOUT)
GOTO SELQ
+17 ;
+18 SET IBNUM=Y
+19 ;
SELQ QUIT IBNUM
