IBECUSMU.m

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 ---IBECUSMU   3643     printed  Mar 13, 2025@21:26:49                                                                                                                                                                                                    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