142 lines
7.0 KiB
Mathematica
142 lines
7.0 KiB
Mathematica
PSOCPA ;BHAM ISC/LGH - PHARMACY CO-PAY CANCEL & RESET STATUS OPTIONS ;05/27/92
|
|
;;7.0;OUTPATIENT PHARMACY;**9,71,85,137,143,201**;DEC 1997
|
|
;
|
|
;REF/IA
|
|
;^IBARX/125
|
|
;^IBE(350.3/2216
|
|
; PSO=1 (REMOVE CHARGE cancel),PSO=2 (UPDATE CHARGE called from EDIT)
|
|
; PSO=3 (REMOVE CHARGE cancel in background processing) ... USED FOR PSOHLNE3
|
|
;
|
|
EN ;Entry point for Remove Co-Pay charge
|
|
S PSOFLAG=0
|
|
S PSO=1 ; Remove Co-Pay charge
|
|
RX ;
|
|
G EXIT:PSO'>0
|
|
W ! S DIC="^PSRX(",DIC(0)="AEQMZ" D ^DIC K DIC G EXIT:Y<0 S PSODA=+Y
|
|
RXED ; Entry point from PSORXED and PSORESK1...requires PSODA,PSO,PSODAYS,PSOFLAG
|
|
N POTBILL
|
|
S PSORXN=$P(^PSRX(PSODA,0),"^") ;..........Rx #
|
|
; Determine if Rx is COPAY
|
|
I +$G(PSOPFS) S PSOREF=+$G(TYPE) G REASON
|
|
I PSO'=3 I '$D(^PSRX(PSODA,"IB")) W !,"Rx # ",PSORXN," is NOT a COPAY transaction...NO action taken." G EXIT
|
|
I PSO'=3 S PSOIB=^PSRX(PSODA,"IB")
|
|
I PSO=2!(PSO=1)!(PSO=3&($G(PSOREF)=0)) I $P(PSOIB,"^",2)'>0 S POTBILL=$P(PSOIB,"^",4) I POTBILL="",'$D(^PSRX(PSODA,1)) G EXIT ; No bill#, no refills
|
|
;I PSO=3&($G(PSOREF)=0) I $P(PSOIB,"^",2)'>0 S POTBILL=$P(PSOIB,"^",4) I POTBILL="",'$D(^PSRX(PSODA,1)) G EXIT ; No bill#, no refills
|
|
; Determine last entry in ^PSRX
|
|
I PSO=3&($D(^PSRX(PSODA,1))) G RXED2
|
|
S PSOREF=0
|
|
G:'$D(^PSRX(PSODA,1)) REASON
|
|
F PSZ=0:0 S PSZ=$O(^PSRX(PSODA,1,PSZ)) Q:PSZ'>0 S PSOREF=PSZ
|
|
S PSOIB=$G(^PSRX(PSODA,1,PSOREF,"IB"))
|
|
RXED2 I PSO=2!(PSO=1)!(PSO=3) I $P(PSOIB,"^",1)'>0 S POTBILL=$P(PSOIB,"^",2)
|
|
G:($P(PSOIB,"^",1)'>0)&($G(POTBILL)'>0) EXIT ; No bill#
|
|
REASON ;
|
|
N PSORD S:PSOREF>0 PSORD=$$GET1^DIQ(52.1,PSOREF_","_PSODA,"17","I") S:PSOREF=0 PSORD=$$GET1^DIQ(52,PSODA,"31","I")
|
|
; Get Cancellation reason
|
|
I PSO=1!(PSO=3) G CANCEL2:$G(PSOPFS)&('$P(+$G(^PSRX(PSODA,"IB")),"^",1)) G PFS:$G(PSOPFS) G CANCEL
|
|
S DIC="^IBE(350.3,",DIC("S")="I $P(^(0),U,3)'=2",DIC(0)="AEQMZ",DIC("A")="Select CHARGE REMOVAL REASON : " D ^DIC S:$G(Y)<0 COPAYFLG=0 K DIC D ENDMSG:Y<0 G EXIT:Y<0 S PSORSN=+Y
|
|
I PSO=2&($G(PSOPFS))&($G(PSORD)) D Q:'$P(+$G(^PSRX(PSODA,"IB")),"^",1) D PFS2 G EXIT
|
|
. D CHRG^PSOPFSU1(PSODA,PSOREF,"CG",PSOPFS) ;only send charge msg if released
|
|
G UPDATE:PSO=2
|
|
G EXIT
|
|
CANCEL ;
|
|
; Set x=service^dfn^^user duz
|
|
; x(n)=IB number^cancellation reason
|
|
N PSOIBST
|
|
;G PFS:$G(PSOPFS)
|
|
I PSOREF=0,$P(PSOIB,"^",2)>0 S PSOIBST=$$STATUS^IBARX($P(PSOIB,"^",2)) I PSOIBST'=1,PSOIBST'=3 G EXITA
|
|
I $G(PSO)=1!(PSO=3) I PSOREF>0,$P(PSOIB,"^",1)>0 S PSOIBST=$$STATUS^IBARX($P(PSOIB,"^",1)) I PSOIBST'=1,PSOIBST'=3 G EXITA
|
|
PFS I PSO'=3 S DIC="^IBE(350.3,",DIC("S")="I $P(^(0),U,3)'=2",DIC(0)="AEQMZ",DIC("A")="Select CHARGE REMOVAL REASON : " D ^DIC S:$G(Y)<0 COPAYFLG=0 K DIC D ENDMSG:Y<0 G EXIT:Y<0 S PSORSN=+Y
|
|
I PSO=3 S DIC="^IBE(350.3,",DIC(0)="QEZ",X="RX EDITED" D ^DIC K DIC G EXIT:Y<0 S PSORSN=+Y
|
|
G CANCEL2:$G(PSOPFS)
|
|
S X=PSOPAR7_"^"_+$P(^PSRX(PSODA,0),"^",2)_"^^"_DUZ
|
|
S:PSOREF=0 X(PSORXN)=$S($G(POTBILL)="":+$P(PSOIB,"^",2),1:POTBILL)_"^"_PSORSN ; Original Rx
|
|
S:PSOREF>0 X(PSORXN)=$S($G(POTBILL)="":+^PSRX(PSODA,1,PSOREF,"IB"),1:POTBILL)_"^"_PSORSN ; Refill Rx
|
|
I $G(POTBILL)'="" D CANIBAM^IBARX G CANCEL2
|
|
D CANCEL^IBARX
|
|
; Return y=1 if success, -1^error code if error
|
|
; y(n)=IB number^total charge^AR bill number
|
|
I +Y=-1 W !,"Error in processing...No action taken." G EXIT
|
|
G EXIT:'$D(Y(PSORXN))
|
|
CANCEL2 I $G(PSOPFS)&($G(PSORD)) D CHRG^PSOPFSU1(PSODA,PSOREF,"CD",PSOPFS) ;only cancel charge if released
|
|
G EXIT:'($P(+$G(^PSRX(PSODA,"IB")),"^",1))
|
|
I $G(PSOPFS) D PFS2 G EXIT
|
|
D FILE
|
|
G EXIT
|
|
FILE ;
|
|
;G PFS2:$G(PSOPFS)
|
|
; File new Bill # in ^PSRX
|
|
I '$G(POTBILL) S:PSOREF=0 $P(^PSRX(PSODA,"IB"),"^",2)=+Y(PSORXN) ;...Original Rx
|
|
I $G(POTBILL) S:PSOREF=0 $P(^PSRX(PSODA,"IB"),"^",4)="" ; IF POTENTIAL BILL IS CANCELLED, REMOVE ITS NUMBER FROM ^PSRX
|
|
I '$G(POTBILL) S:PSOREF>0 ^PSRX(PSODA,1,PSOREF,"IB")=+Y(PSORXN) ; ...Refill Rx
|
|
I $G(POTBILL) S:PSOREF>0 $P(^PSRX(PSODA,1,PSOREF,"IB"),"^",2)="" ; ...Refill Rx (REMOVE "POTENTIAL" BILL NUMBER WHEN CANCELLED)
|
|
PFS2 ;
|
|
I PSO=1 W !!,"Co-Pay transaction for Rx # ",PSORXN,$S(PSOREF>0:" refill # "_PSOREF,1:"")," has been cancelled." S PREA="C",PSOCOMM="Returned to stock"
|
|
I PSO=2 W !!,"Co-Pay transaction for Rx # ",PSORXN,$S(PSOREF>0:" refill # "_PSOREF,1:"")," has been updated." S PREA="E",PSOCOMM="Days supply change. Copay amount updated"
|
|
D ACTLOG
|
|
Q
|
|
UPDATE ;if days supply changes during Rx edit, cancel old bill and get new bill number
|
|
N SAVEDA
|
|
S SAVEDA=$G(DA)
|
|
I PSOFLAG=0 W !,"Use Pharmacy Manager Option - Edit Prescriptions - to UPDATE this Rx." G EXIT
|
|
;
|
|
; Set x=service^dfn^action type^user duz.....x value for update
|
|
; x(n)=softlink^units^IB number of parent to cancel^Cancellation reason
|
|
;
|
|
;
|
|
S X=PSOPAR7_"^"_+$P(^PSRX(PSODA,0),"^",2)_"^"_$P(^PSRX(PSODA,"IB"),"^")_"^"_DUZ
|
|
; Units for COPAY
|
|
S PSOCPUN=$P(($P(^PSRX(PSODA,0),"^",8)+29)/30,".",1)
|
|
G EXIT:PSOCPUN=$P((PSODAYS+29)/30,".",1) ; No change if UNITS unchanged
|
|
;
|
|
; Build softlink for x(n)
|
|
S X(PSORXN)="52:"_PSODA S:PSOREF>0 X(PSORXN)=X(PSORXN)_";1:"_PSOREF
|
|
;
|
|
; Set IB number of Parent record to update
|
|
S PSOPARNT=$S(PSOREF=0:+$P(^PSRX(PSODA,"IB"),"^",2),PSOREF>0:+^PSRX(PSODA,1,PSOREF,"IB"),1:0)
|
|
S X(PSORXN)=X(PSORXN)_"^"_PSOCPUN_"^"_PSOPARNT_"^"_PSORSN
|
|
I $G(POTBILL)'="" D
|
|
. S $P(X(PSORXN),"^",3)=POTBILL
|
|
. I $T(UPIBAM^IBARX)="" Q
|
|
. D UPIBAM^IBARX
|
|
I '$G(POTBILL) D UPDATE^IBARX
|
|
; Return y=1 if success, -1^error code if error
|
|
; y(n)=IB number^total charge^AR bill number
|
|
I +Y=-1 W !,"Error in processing...No action taken." G EXIT
|
|
G EXIT:'$D(Y(PSORXN))
|
|
PFS3 ;
|
|
D FILE
|
|
G EXIT
|
|
;
|
|
RXDEL ; Entry point when Rx is deleted thru menu option -- THIS ENTRY POINT NO LONGER USED WITH MILL BILL COPAY CHANGES
|
|
K DIC S DIC="^IBE(350.3,",DIC(0)="M",X="RX DELETED" D ^DIC K DIC Q:+Y<0 S PSORSN=+Y
|
|
K Y
|
|
S PSODA=RXN,PSORXN=+RX
|
|
S X=PSOPAR7_"^"_+$P(RX,"^",2)_"^^"_DUZ
|
|
S X(PSORXN)=+$P(PSOIB,"^",2)_"^"_PSORSN ; Original Rx
|
|
D CANCEL^IBARX
|
|
W:+Y=1 !!,"Copay transaction for this Rx has been cancelled."
|
|
S PREA="C" D ACTLOG
|
|
G EXIT
|
|
EXITA ;
|
|
I PSO=1 W !!,"Co-Pay transaction for Rx # ",PSORXN,$S(PSOREF>0:" refill # "_PSOREF,1:"")," has previously been cancelled."
|
|
EXIT I $D(SAVEDA) S DA=SAVEDA ;
|
|
I PSO'=3 K PSO,PSOCPUN,PSODA,PSOFLAG,PSOIB,PSOPARNT,PSOREF,PSORSN,PSORXN,PSZ,X,Y Q
|
|
I PSO=3 K PSOCPUN,PSOPARNT,PSORXN,X,Y
|
|
Q
|
|
ENDMSG ;
|
|
I PSO'=3 W !!,"Unable to UPDATE COPAY TRANSACTON without REMOVAL REASON entry."
|
|
Q
|
|
ACTLOG ;ENTER MESSAGE INTO RX COPAY ACTIVITY LOG
|
|
Q:+$G(PSOPFS)&('$D(^PSRX(PSODA,"IB"))) ;don't set copay activity log when no copay when send Rx to external bill sys
|
|
N X,Y
|
|
S:'$D(PREA) PREA="R" D NOW^%DTC S PSI=0
|
|
ACTL S PSI=+$O(^PSRX(PSODA,"COPAY",PSI)) G:$O(^PSRX(PSODA,"COPAY",PSI)) ACTL
|
|
K DIC,PSORSNZ I $G(PSORSN)'="" S DIC="^IBE(350.3,",DIC(0)="M",X="`"_PSORSN D ^DIC K DIC I $G(Y) S PSORSNZ=$P($G(Y),"^",2)
|
|
S PSORSNZ=$G(PSORSNZ)_$S($G(PSORSNZ)="":"",1:" ")_$G(PSOCOMM)
|
|
S ^PSRX(PSODA,"COPAY",+PSI+1,0)=%_"^"_PREA_"^"_DUZ_"^"_$G(PSOREF)_"^"_PSORSNZ_"^"_$G(PSOOLD)_"^"_$G(PSONW)
|
|
S ^PSRX(PSODA,"COPAY",0)="^52.0107DA^"_(+PSI+1)_"^"_(+PSI+1)
|
|
K PSORSNZ
|
|
Q
|
|
;
|