| [613] | 1 | PSOCPTRI ;BHAM ISC/CPM,RTR - SUPPORT FOR CHAMPUS RX BILLING ;14-AUG-96
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**10,55,184**;DEC 1997
|
|---|
| 3 | ;External reference to ^PSDRUG supported by DBIA 221
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | TRANS(ORIG,REF,PSOV) ; Extract Rx information for transmission to FI
|
|---|
| 7 | ; Input: ORIG -- Pointer to the rx in file #52
|
|---|
| 8 | ; REF -- Pointer to the refill in file #52.1
|
|---|
| 9 | ; (This is 0 if we are billing the original fill)
|
|---|
| 10 | ; PSOV -- Passed by reference. This array will be used
|
|---|
| 11 | ; to return the output (described below).
|
|---|
| 12 | ; Output: PSOE -- This is normally 1, or -1 if the NDC cannot
|
|---|
| 13 | ; be determined.
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | ; Description of output variables to be passed to billing:
|
|---|
| 17 | ;
|
|---|
| 18 | ; PSOV("NDC") NDC # from the DRUG (#50) file
|
|---|
| 19 | ; PSOV("DIV") Pharmacy (in file #59) dispensing the rx
|
|---|
| 20 | ; PSOV("FDT") Rx Fill Date
|
|---|
| 21 | ; Last fill, field #101, or
|
|---|
| 22 | ; Dispensed, field #25
|
|---|
| 23 | ; PSOV("RX#") Prescription number, field #.01
|
|---|
| 24 | ; PSOV("QTY") Quantity, field #7
|
|---|
| 25 | ; PSOV("SUP") Days Supply, field #8
|
|---|
| 26 | ; PSOV("ISS") Issue Date, field #1
|
|---|
| 27 | ; PSOV("#REF") # Refills, field #9
|
|---|
| 28 | ; PSOV("COMP") 2 if manufactured in Pharmacy, else 1
|
|---|
| 29 | ; PSOV("DEA") DEA number from "PS" node in File 200
|
|---|
| 30 | ;
|
|---|
| 31 | N PSOE,PSORX S PSOE=1
|
|---|
| 32 | ;
|
|---|
| 33 | S PSORX(0)=$G(^PSRX(ORIG,0)),PSORX(2)=$G(^(2)),PSORX(3)=$G(^(3))
|
|---|
| 34 | S:$G(REF) PSORX("REF")=$G(^PSRX(ORIG,1,REF,0))
|
|---|
| 35 | I PSORX(0)="" S PSOE=-1 G TRANSQ
|
|---|
| 36 | ;
|
|---|
| 37 | S PSOV("RX#")=$P(PSORX(0),"^") ; prescription number
|
|---|
| 38 | ; - first check for a valid NDC #
|
|---|
| 39 | S PSOV("NDC")=$P($G(^PSDRUG(+$P(PSORX(0),"^",6),2)),"^",4)
|
|---|
| 40 | I +PSOV("NDC")=0 S PSOE=-1 G TRANSQ
|
|---|
| 41 | ;
|
|---|
| 42 | ; - extract everything else
|
|---|
| 43 | S PSOV("DIV")=$S($P($G(PSORX("REF")),"^",9):$P(PSORX("REF"),"^",9),1:$P(PSORX(2),"^",9)) ; pharmacy division
|
|---|
| 44 | S PSOV("FDT")=$S($G(REF):$E($P(PSORX("REF"),"^"),1,7),1:$E($P(PSORX(2),"^",2),1,7))
|
|---|
| 45 | I PSOV("FDT")="" S PSOV("FDT")=$S($P(PSORX(3),"^"):$P(PSORX(3),"^"),1:$P(PSORX(2),"^",5))
|
|---|
| 46 | ;
|
|---|
| 47 | S PSOV("QTY")=$S($P($G(PSORX("REF")),"^",4)'="":$P(PSORX("REF"),"^",4),1:$P(PSORX(0),"^",7)) ; quantity
|
|---|
| 48 | S PSOV("SUP")=$S($P($G(PSORX("REF")),"^",10)'="":$P(PSORX("REF"),"^",10),1:$P(PSORX(0),"^",8)) ; days supply
|
|---|
| 49 | S PSOV("ISS")=$P(PSORX(0),"^",13) ; date rx written
|
|---|
| 50 | S PSOV("#REF")=$P(PSORX(0),"^",9) ; # refills authorized
|
|---|
| 51 | ;
|
|---|
| 52 | N PSOX S PSOX=+$P(PSORX(0),"^",6) S PSOV("COMP")=$P($G(^PSDRUG(PSOX,0)),"^",3) S PSOV("COMP")=$S(PSOV("COMP")[0:2,1:1) ; Compound drug
|
|---|
| 53 | ;
|
|---|
| 54 | S PSOV("DEA")=$S($P(PSORX(0),"^",4):$P($G(^VA(200,$P(PSORX(0),"^",4),"PS")),"^",2),1:"") ; DEA #
|
|---|
| 55 | ;
|
|---|
| 56 | ;
|
|---|
| 57 | TRANSQ Q PSOE
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | LABEL(RX,PSOLAP,PSOSITE,DUZ,PSOTRAMT) ; Print the label.
|
|---|
| 61 | ; Input: RX -- Pointer to the prescription in file #52
|
|---|
| 62 | ; PSOLAP -- Label printer
|
|---|
| 63 | ; PSOSITE -- Pointer to the Pharmacy in file #59
|
|---|
| 64 | ; DUZ -- Pointer to the use in file #200
|
|---|
| 65 | ; PSOTRAMT -- Amount to be paid
|
|---|
| 66 | ;
|
|---|
| 67 | ;
|
|---|
| 68 | Q:PSOLAP["LAT-TERM"
|
|---|
| 69 | Q:'$D(^PSRX(RX,0))
|
|---|
| 70 | Q:'$D(^PS(59,PSOSITE,0))
|
|---|
| 71 | N CT,II,III,NOW,RXFF,X,Y,PSOSYS,PSOPAR,PSOBARS,PDUZ,PSOBAR0,PSOBAR1,REPRINT,PSOCHAMP,PSHRX,DIQUIET
|
|---|
| 72 | S DIQUIET=1 D DT^DICRW
|
|---|
| 73 | I '$G(DT) S DT=$$DT^XLFDT
|
|---|
| 74 | S:$P($G(^PSRX(RX,"STA")),"^")'=3 REPRINT=""
|
|---|
| 75 | D:$P($G(^PSRX(RX,"STA")),"^")=3
|
|---|
| 76 | .S RXFF=0 F II=0:0 S II=$O(^PSRX(RX,1,II)) Q:'II S RXFF=II
|
|---|
| 77 | .K DIE S DIE="^PSRX(",DA=RX,DR=$S('RXFF:"22///"_DT_";",1:"")_"100///"_0_";101///"_$S('RXFF:DT,1:+$P($G(^PSRX(RX,1,+$G(RXFF),0)),"^")) D ^DIE K DIE
|
|---|
| 78 | .S PSHRX=RX D EN^PSOHLSN1(RX,"OE","","Rx removed from CHAMPUS billing hold","A") S RX=PSHRX
|
|---|
| 79 | .K ^PSRX("AH",+$P($G(^PSRX(RX,"H")),"^"),RX) S ^PSRX(DA,"H")=""
|
|---|
| 80 | .D NOW^%DTC S NOW=%
|
|---|
| 81 | .S III=0 F CT=0:0 S CT=$O(^PSRX(RX,"A",CT)) Q:'CT S III=CT
|
|---|
| 82 | .S III=III+1,^PSRX(RX,"A",0)="^52.3DA^"_III_"^"_III
|
|---|
| 83 | .S ^PSRX(RX,"A",III,0)=NOW_"^"_"U"_"^"_+$G(DUZ)_"^"_$S(RXFF<6:RXFF,1:(RXFF+1))_"^"_"Rx removed from CHAMPUS billing hold"
|
|---|
| 84 | ;
|
|---|
| 85 | IO S %ZIS="",IOP=PSOLAP D ^%ZIS I POP H 5 G IO
|
|---|
| 86 | N PSOIOS S PSOIOS=IOS D DEVBAR^PSOBMST
|
|---|
| 87 | S PSOSYS=$G(^PS(59,PSOSITE,1))
|
|---|
| 88 | S PSOPAR=$G(^PS(59,PSOSITE,1)),PDUZ=DUZ
|
|---|
| 89 | S PPL=RX
|
|---|
| 90 | S PSOCHAMP=1
|
|---|
| 91 | S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&($P(PSOPAR,"^",19))
|
|---|
| 92 | D DQ^PSOLBL
|
|---|
| 93 | D ^%ZISC
|
|---|
| 94 | ;
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | ;
|
|---|
| 98 | CHK(ORIG,REF) ; Should this rx be billed to the CHAMPUS Fiscal Intermediary?
|
|---|
| 99 | ; Input: ORIG -- Pointer to the rx in file #52
|
|---|
| 100 | ; REF -- Pointer to the refill in file #52.1, or
|
|---|
| 101 | ; 0 for the original fill
|
|---|
| 102 | ; Output: PSOB -- 0 => The rx should not be billed
|
|---|
| 103 | ; 1 => The rx may be billed.
|
|---|
| 104 | ;
|
|---|
| 105 | N PSOB
|
|---|
| 106 | ;
|
|---|
| 107 | ; - ignore CHAMPUS billing for certain RX Patient Statuses
|
|---|
| 108 | I $P($G(^PS(53,+$P($G(^PSRX(+$G(ORIG),0)),"^",3),0)),"^",8) G CHKQ
|
|---|
| 109 | ;
|
|---|
| 110 | S PSOB=1
|
|---|
| 111 | ;
|
|---|
| 112 | CHKQ Q +$G(PSOB)
|
|---|
| 113 | ;
|
|---|
| 114 | DEV ;Get devices
|
|---|
| 115 | N PSOTRION
|
|---|
| 116 | S PSOTRION=ION
|
|---|
| 117 | I $G(PSOLAP)]"",$G(PSOLAP)'=ION Q
|
|---|
| 118 | DEVA W ! S %ZIS("B")="",%ZIS="MNQ",%ZIS("A")="Select LABEL DEVICE: " D ^%ZIS I POP!($E(IOST)'["P") W !,"Label Printer device must be selected!",! G DEVA
|
|---|
| 119 | S PSOLAP=ION
|
|---|
| 120 | N PSOIOS S PSOIOS=IOS D DEVBAR^PSOBMST
|
|---|
| 121 | S PSOBARS=PSOBAR1]""&(PSOBAR0]"")&($P($G(PSOPAR),"^",10))
|
|---|
| 122 | D ^%ZISC S ION=PSOTRION Q
|
|---|
| 123 | ;
|
|---|
| 124 | EXM ;Edit Champus Billing Exemption field
|
|---|
| 125 | I '$D(PSOPAR) D ^PSOLSET G EXM
|
|---|
| 126 | W ! K DIC S DIC="^PS(53,",DIC(0)="AEQMZ" D ^DIC K DIC I Y<0!($D(DTOUT))!($D(DUOUT)) G EXMQ
|
|---|
| 127 | W ! K DIE S DA=+Y,DIE="^PS(53,",DR=16 D ^DIE
|
|---|
| 128 | EXMQ K DIE,DIC,Y
|
|---|
| 129 | Q
|
|---|
| 130 | RESDIR ;Reset DIR just in case
|
|---|
| 131 | S DIR("A")="LABEL: QUEUE"_$S($P(PSOPAR,"^",23):"/HOLD",1:"")_$S($P(PSOPAR,"^",24):"/SUSPEND",1:"")_$S($P(PSOPAR,"^",26):"/LABEL",1:"")_" or '^' to bypass "
|
|---|
| 132 | S DIR("?",1)="Enter 'Q' to queue labels to print",DIR("?")="Enter '^' to bypass label functions",DIR("?",4)="Enter 'S' to suspend labels to print later"
|
|---|
| 133 | S DIR("?",2)="Enter 'H' to hold label until Rx can be filled",DIR("?",3)="Enter 'P' for Rx profile"
|
|---|
| 134 | S:$P(PSOPAR,"^",26) DIR("?",5)="Enter 'L' to print labels without queuing"
|
|---|
| 135 | Q
|
|---|
