68 lines
2.6 KiB
Mathematica
68 lines
2.6 KiB
Mathematica
PSOCPIB ;BHAM ISC/EJW - PHARMACY CO-PAY IB-INITIATED COPAY CHARGE ; 07/27/01
|
|
;;7.0;OUTPATIENT PHARMACY;**71,137**;DEC 1997
|
|
;External reference to IBARX supported by DBIA 125
|
|
; files IB-initiated charges into original or refill node
|
|
; IB passes date/time^person initiating copay^Rx#^Fill#^Partial or full charge^IB transaction IEN from file #350
|
|
N PSODA,PSOCOMM,PSOREF,PREA,SAVEDUZ,PSORSN
|
|
S PREA="I"
|
|
S SAVEDUZ=DUZ
|
|
S DUZ=$P(Y(1),"^",2)
|
|
S PSODA=$P(Y(1),"^",3)
|
|
I 'PSODA Q
|
|
S PSOREF=$P(Y(1),"^",4)
|
|
D CHKIB
|
|
S PSOCOMM=$S($P(Y(1),"^",5)="F":"FULL CHARGE",1:"PARTIAL CHARGE")
|
|
FILE ; File IB number in ^PSRX
|
|
S:PSOREF>0 ^PSRX(PSODA,1,PSOREF,"IB")=$P(Y(1),"^",6) ; Filing in refill node
|
|
I PSOREF>0,'$D(^PSRX(PSODA,"IB")) S ^PSRX(PSODA,"IB")="^^" ; If refill "IB" exists, need "IB" entry on original fill node
|
|
S:PSOREF=0 $P(^PSRX(PSODA,"IB"),"^",2)=$P(Y(1),"^",6) ;Filing in original fill (zero node)
|
|
D ACTLOG^PSOCPA
|
|
I $P($G(^PSRX(PSODA,"IB")),"^",1)="" D CANCEL ; IF Rx is 'no copay', send a cancel back to IB in 10 minutes for their IB-initiated charge
|
|
S DUZ=SAVEDUZ
|
|
Q
|
|
;
|
|
CANCEL ;
|
|
S ZTRTN="CANCHG^PSOCPIB"
|
|
S ZTDESC="Call IB back to cancel charges"
|
|
S PSORX=Y(1)_"^"_$G(PSOPAR7)
|
|
S ZTSAVE("PSORX")=""
|
|
S ZTDTH=$$HADD^XLFDT($H,0,0,10),ZTIO=""
|
|
D ^%ZTLOAD
|
|
Q
|
|
;
|
|
CANCHG ; Cancel charges if IB initiates a charge for a 'no copay' Rx
|
|
N PSODA,PSOCOMM,PSOREF,PREA,SAVEDUZ,X
|
|
S PREA="C"
|
|
S DUZ=$P(PSORX,"^",2)
|
|
S PSODA=$P(PSORX,"^",3)
|
|
S PSOREF=$P(PSORX,"^",4)
|
|
S PSOPAR7=$P(PSORX,"^",7)
|
|
S X=PSOPAR7_"^"_+$P(^PSRX(PSODA,0),"^",2)_"^^"_DUZ
|
|
I PSOREF=0 D I $O(X(""))="" Q
|
|
. I $P($G(^PSRX(PSODA,"IB")),"^",2)>0 S X(PSODA)=$P(^PSRX(PSODA,"IB"),"^",2)_"^40"
|
|
I PSOREF>0 D I $O(X(""))="" Q
|
|
. I $P($G(^PSRX(PSODA,1,PSOREF,"IB")),"^",1)>0 S X(PSODA)=$P(^PSRX(PSODA,1,PSOREF,"IB"),"^",1)_"^40"
|
|
D CANCEL^IBARX
|
|
I $D(Y(PSODA)),+$G(Y(PSODA))'=-1 D
|
|
. S $P(^PSRX(PSODA,"IB"),"^",2)=+Y(PSODA),$P(^PSRX(PSODA,"IB"),"^",4)="" K Y(PSODA)
|
|
. S PREA="C",PSOREF=0,PSOCOMM="AUTO-CANCEL IB-INITIATED CHARGE FOR 'NO COPAY' RX" D ACTLOG^PSOCPA
|
|
F PSOREF=0:0 S PSOREF=$O(Y(PSOREF)) Q:PSOREF="" Q:PSOREF>12 D
|
|
. I +Y(PSOREF)'=-1,$D(^PSRX(PSODA,1,PSOREF)) S ^PSRX(PSODA,1,PSOREF,"IB")=+Y(PSOREF)
|
|
. S PREA="C",PSOCOMM="AUTO-CANCEL IB-INITIATED CHARGE FOR 'NO COPAY' RX" D ACTLOG^PSOCPA
|
|
Q
|
|
;
|
|
CHKIB ; SEE IF IB NUMBER ALREADY EXISTS AND IS A BILL OR UPDATE NUMBER (NOT A CANCEL NUMBER)
|
|
N PSOIB,PSOSTAT
|
|
I PSOREF=0 S PSOIB=$P($G(^PSRX(PSODA,"IB")),"^",2)
|
|
I PSOREF'=0 S PSOIB=$P($G(^PSRX(PSODA,1,PSOREF,"IB")),"^",1)
|
|
I PSOIB'="" D STATUS
|
|
Q
|
|
;
|
|
STATUS ;
|
|
S PSOSTAT=$$STATUS^IBARX(PSOIB)
|
|
I PSOSTAT'=1,PSOSTAT'=3 Q
|
|
S PSOCOMM="Copay charge(s) removed"
|
|
D ACTLOG^PSOCPA
|
|
Q
|
|
;
|