| 1 | PSOCPIB ;BHAM ISC/EJW - PHARMACY CO-PAY IB-INITIATED COPAY CHARGE ; 07/27/01
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**71,137**;DEC 1997
|
|---|
| 3 | ;External reference to IBARX supported by DBIA 125
|
|---|
| 4 | ; files IB-initiated charges into original or refill node
|
|---|
| 5 | ; IB passes date/time^person initiating copay^Rx#^Fill#^Partial or full charge^IB transaction IEN from file #350
|
|---|
| 6 | N PSODA,PSOCOMM,PSOREF,PREA,SAVEDUZ,PSORSN
|
|---|
| 7 | S PREA="I"
|
|---|
| 8 | S SAVEDUZ=DUZ
|
|---|
| 9 | S DUZ=$P(Y(1),"^",2)
|
|---|
| 10 | S PSODA=$P(Y(1),"^",3)
|
|---|
| 11 | I 'PSODA Q
|
|---|
| 12 | S PSOREF=$P(Y(1),"^",4)
|
|---|
| 13 | D CHKIB
|
|---|
| 14 | S PSOCOMM=$S($P(Y(1),"^",5)="F":"FULL CHARGE",1:"PARTIAL CHARGE")
|
|---|
| 15 | FILE ; File IB number in ^PSRX
|
|---|
| 16 | S:PSOREF>0 ^PSRX(PSODA,1,PSOREF,"IB")=$P(Y(1),"^",6) ; Filing in refill node
|
|---|
| 17 | I PSOREF>0,'$D(^PSRX(PSODA,"IB")) S ^PSRX(PSODA,"IB")="^^" ; If refill "IB" exists, need "IB" entry on original fill node
|
|---|
| 18 | S:PSOREF=0 $P(^PSRX(PSODA,"IB"),"^",2)=$P(Y(1),"^",6) ;Filing in original fill (zero node)
|
|---|
| 19 | D ACTLOG^PSOCPA
|
|---|
| 20 | 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
|
|---|
| 21 | S DUZ=SAVEDUZ
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | CANCEL ;
|
|---|
| 25 | S ZTRTN="CANCHG^PSOCPIB"
|
|---|
| 26 | S ZTDESC="Call IB back to cancel charges"
|
|---|
| 27 | S PSORX=Y(1)_"^"_$G(PSOPAR7)
|
|---|
| 28 | S ZTSAVE("PSORX")=""
|
|---|
| 29 | S ZTDTH=$$HADD^XLFDT($H,0,0,10),ZTIO=""
|
|---|
| 30 | D ^%ZTLOAD
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | CANCHG ; Cancel charges if IB initiates a charge for a 'no copay' Rx
|
|---|
| 34 | N PSODA,PSOCOMM,PSOREF,PREA,SAVEDUZ,X
|
|---|
| 35 | S PREA="C"
|
|---|
| 36 | S DUZ=$P(PSORX,"^",2)
|
|---|
| 37 | S PSODA=$P(PSORX,"^",3)
|
|---|
| 38 | S PSOREF=$P(PSORX,"^",4)
|
|---|
| 39 | S PSOPAR7=$P(PSORX,"^",7)
|
|---|
| 40 | S X=PSOPAR7_"^"_+$P(^PSRX(PSODA,0),"^",2)_"^^"_DUZ
|
|---|
| 41 | I PSOREF=0 D I $O(X(""))="" Q
|
|---|
| 42 | . I $P($G(^PSRX(PSODA,"IB")),"^",2)>0 S X(PSODA)=$P(^PSRX(PSODA,"IB"),"^",2)_"^40"
|
|---|
| 43 | I PSOREF>0 D I $O(X(""))="" Q
|
|---|
| 44 | . I $P($G(^PSRX(PSODA,1,PSOREF,"IB")),"^",1)>0 S X(PSODA)=$P(^PSRX(PSODA,1,PSOREF,"IB"),"^",1)_"^40"
|
|---|
| 45 | D CANCEL^IBARX
|
|---|
| 46 | I $D(Y(PSODA)),+$G(Y(PSODA))'=-1 D
|
|---|
| 47 | . S $P(^PSRX(PSODA,"IB"),"^",2)=+Y(PSODA),$P(^PSRX(PSODA,"IB"),"^",4)="" K Y(PSODA)
|
|---|
| 48 | . S PREA="C",PSOREF=0,PSOCOMM="AUTO-CANCEL IB-INITIATED CHARGE FOR 'NO COPAY' RX" D ACTLOG^PSOCPA
|
|---|
| 49 | F PSOREF=0:0 S PSOREF=$O(Y(PSOREF)) Q:PSOREF="" Q:PSOREF>12 D
|
|---|
| 50 | . I +Y(PSOREF)'=-1,$D(^PSRX(PSODA,1,PSOREF)) S ^PSRX(PSODA,1,PSOREF,"IB")=+Y(PSOREF)
|
|---|
| 51 | . S PREA="C",PSOCOMM="AUTO-CANCEL IB-INITIATED CHARGE FOR 'NO COPAY' RX" D ACTLOG^PSOCPA
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | CHKIB ; SEE IF IB NUMBER ALREADY EXISTS AND IS A BILL OR UPDATE NUMBER (NOT A CANCEL NUMBER)
|
|---|
| 55 | N PSOIB,PSOSTAT
|
|---|
| 56 | I PSOREF=0 S PSOIB=$P($G(^PSRX(PSODA,"IB")),"^",2)
|
|---|
| 57 | I PSOREF'=0 S PSOIB=$P($G(^PSRX(PSODA,1,PSOREF,"IB")),"^",1)
|
|---|
| 58 | I PSOIB'="" D STATUS
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | STATUS ;
|
|---|
| 62 | S PSOSTAT=$$STATUS^IBARX(PSOIB)
|
|---|
| 63 | I PSOSTAT'=1,PSOSTAT'=3 Q
|
|---|
| 64 | S PSOCOMM="Copay charge(s) removed"
|
|---|
| 65 | D ACTLOG^PSOCPA
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
