PSOTRI ;BIRM/BNT - OP TRICARE/CHAMPVA Audit Log Utilities ;07/21/2010
;;7.0;OUTPATIENT PHARMACY;**358,385,427,528**;DEC 1997;Build 10
;
; Reference to DUR1^BPSNCPD3 supported by IA 4560
;
Q
;
;
AUDIT(RX,RFL,RXCOB,JST,AUD,ELIG) ;
; Main entry to create a new record in the PSO AUDIT LOG file #52.87
; Note that AUDIT^PSOTRI is called by ECME (BPSECMP2) - ICR 6156
; INPUT: RX (r) = Prescription IEN
; RFL (o) = Prescription Fill # (Default is original zero fill)
; RXCOB (o) = Coordination of Benefits
; 1 = Primary (Default)
; 2 = Secondary
; JST (o) = Justification text
; AUD (r) = Audit Type
; R = NCPDP REJECT - Associated with an Override audit action
; N = NON BILLABLE - Associated with an Override audit action
; I = INPATIENT - Associated with a Bypass audit action
; P = PARTIAL FILL
; ELIG (r) = Eligibility Type
; T = TRICARE
; C = CHAMPVA
; RETURN: Successful Audit entry will return the IEN of the new entry in file 52.87
; Unsuccessful Audit entry will return "0^Error Description"
;
N PSOTRIC,PSODIV,RXFLDS,RFLFLDS,RXECME,PSOFDA,FN,SFN,PSOIEN,PSOIENS,PSOUSER,PSOTC,PSOET
N I,PSOAIEN,PSOREJ,DFN,PSODOA,PSODOS,PSOERR,PSOX,PSOY,RXARR,RFLARR,PSOPHRM,PSOQTY
N PDDATE,PFARR,PFFLDS,PFIEN,PSOPFIEN,PSOUNITCOST
;
Q:'$D(^PSRX(RX,0)) "0^Prescription does not exist"
; Verify refill exists
I RFL=""!RFL<0 S RFL=$$LSTRFL^PSOBPSU1(RX)
;
; Not original fill
I RFL Q:'$D(^PSRX(RX,1,RFL)) "0^Refill "_RFL_" does not exist"
;
; Verify eligibility exists
Q:ELIG="" "0^Eligibiltiy does not exist"
;
; Verify Eligibility Type - TRICARE or CHAMPVA patient
I ("/T/C/")'[("/"_ELIG_"/") Q "0^Invalid Eligibility Type "_ELIG
; PSOTRIC is used below to determine if there is a eT or eC reject code
S (PSOTRIC,PSOTC)="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
;
; Verify Audit Type
I ("/R/N/I/P/")'[("/"_AUD_"/") Q "0^Invalid Audit Type "_AUD
;
; Coordination of Benefits (default is Primary)
S RXCOB=+$G(RXCOB) I RXCOB=0 S RXCOB=1
; Audit File and Reject subfile
S FN=52.87,SFN=52.8713
;
; Fields for original fill:
; PROVIDER;NDC;DRUG NAME;QUANTITY;PATIENT;PATIENT STATUS;PHARMACIST;UNIT PRICE OF DRUG
S RXFLDS="4;27;6;7;2;3;23;17"
; Fields for refills
; PROVIDER;NDC;QUANTITY;PHARMACIST
S RFLFLDS="15;11;1;4"
;
; Get data from RX
D GETS^DIQ(52,RX,RXFLDS,"I","RXARR")
; Get data from Refill
I RFL D GETS^DIQ(52.1,RFL_","_RX,RFLFLDS,"I","RFLARR")
; Get Division
S PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
; ECME Number, if exists
S RXECME=$$ECMENUM^PSOBPSU2(RX,RFL)
; Date of Action is NOW
S PSODOA=$$NOW^XLFDT()
; Date of Service
S PSODOS=$$DOS^PSOBPSU1(RX,RFL)
; User (If null OR Audit Type is Inpatient OR bypass-type reject, set to POSTMASTER)
S PSOUSER=DUZ
I (PSOUSER="")!(AUD="I")!$$BYPASS^PSOBPSU1(ELIG,JST) S PSOUSER=.5
; Set up FDA array
S PSOIEN="+1,"
S PSOAIEN=$P($G(^PS(52.87,0)),U,3)+1
;
; Quantity, Provider and NDC fields
I AUD="P" D
. ; For Partial Fills pull the QTY, PROVIDER and NDC and from
. ; the appropriate entry in the PARTIAL DATE sub-file #52.2.
. ; Attempt to identify a partial fill for today's date.
. S PSOPFIEN=""
. S PFIEN=0 F S PFIEN=$O(^PSRX(RX,"P",PFIEN)) Q:'PFIEN S PDDATE=$P($G(^PSRX(RX,"P",PFIEN,0)),U,8) I $P(PDDATE,".")=$P(PSODOA,".") S PSOPFIEN=PFIEN
. ; partial fill entry for today not found
. I 'PSOPFIEN Q
. ;
. ;QTY;CURRENT UNIT PRICE OF DRUG;PROVIDER;NDC
. S PFFLDS=".04;.042;6;1"
. D GETS^DIQ(52.2,PSOPFIEN_","_RX,PFFLDS,"I","PFARR")
. S PSOQTY=$G(PFARR(52.2,PSOPFIEN_","_RX_",",.04,"I"))
. ;Get the UNIT PRICE OF DRUG from the Prescription, the UNIT PRICE isn't stored
. ; with the partial fill until later in the processing.
. S PSOUNITCOST=$G(RXARR(52,RX_",",17,"I"))
. ; PROVIDER field
. S PSOFDA(FN,PSOIEN,5)=$G(PFARR(52.2,PSOPFIEN_","_RX_",",6,"I"))
. ; NDC field
. S PSOFDA(FN,PSOIEN,6)=$G(PFARR(52.2,PSOPFIEN_","_RX_",",1,"I"))
. I PSOFDA(FN,PSOIEN,6)'="" S PSOFDA(FN,PSOIEN,6)=$G(RXARR(52,RX_",",27,"I"))
. ; BILL COST field
. S PSOFDA(FN,PSOIEN,8)=(PSOUNITCOST*PSOQTY)+8
E D
. S PSOQTY=$S(RFL>0:$G(RFLARR(52.1,RFL_","_RX_",",1,"I")),1:$G(RXARR(52,RX_",",7,"I")))
. ; PROVIDER field
. S PSOFDA(FN,PSOIEN,5)=$S(RFL>0:$G(RFLARR(52.1,RFL_","_RX_",",15,"I")),1:$G(RXARR(52,RX_",",4,"I")))
. ; NDC field
. S PSOFDA(FN,PSOIEN,6)=$S(RFL>0:$G(RFLARR(52.1,RFL_","_RX_",",11,"I")),1:$G(RXARR(52,RX_",",27,"I")))
. ; BILL COST field
. S PSOFDA(FN,PSOIEN,8)=$G(RXARR(52,RX_",",17,"I"))*PSOQTY+8 ;This needs to be verified
;
; AUDIT ID field
S PSOFDA(FN,PSOIEN,.01)=PSOAIEN
; PRESCRIPTION field
S PSOFDA(FN,PSOIEN,1)=RX
; FILL field
S PSOFDA(FN,PSOIEN,2)=RFL
; PATIENT field
S PSOFDA(FN,PSOIEN,3)=$G(RXARR(52,RX_",",2,"I"))
; DIVISION field
S PSOFDA(FN,PSOIEN,4)=PSODIV
; DRUG field
S PSOFDA(FN,PSOIEN,7)=$G(RXARR(52,RX_",",6,"I"))
; ECME NUMBER field
S PSOFDA(FN,PSOIEN,9)=RXECME
; QTY field
S PSOFDA(FN,PSOIEN,10)=PSOQTY
; PATIENT STATUS field
S PSOFDA(FN,PSOIEN,11)=$G(RXARR(52,RX_",",3,"I"))
; AUDIT TYPE field
S PSOFDA(FN,PSOIEN,12)=AUD
; USER field
S PSOFDA(FN,PSOIEN,14)=PSOUSER
; DATE OF ACTION field
S PSOFDA(FN,PSOIEN,15)=PSODOA
; DATE OF SERVICE field
S PSOFDA(FN,PSOIEN,16)=PSODOS
; TRICARE JUSTIFICATION field
S PSOFDA(FN,PSOIEN,17)=JST
; Eligibility Code
S PSOFDA(FN,PSOIEN,18)=ELIG
;
D DUR1^BPSNCPD3(RX,RFL,.PSOREJ,.PSOERR,RXCOB)
S PSOET=$$PSOET^PSOREJP3(RX,RFL) ;check to see if eT or eC is the reject code as no ecme claim.
I PSOET S PSOTC=$S(PSOTRIC=1:"eT",PSOTRIC=2:"eC",1:"")
I PSOTC]"",'$D(PSOREJ(RXCOB,"REJ CODES")) S PSOREJ(RXCOB,"REJ CODES",1,PSOTC)="",PSOREJ(RXCOB,"REJ CODE LST")=PSOTC
I $G(PSOREJ(RXCOB,"REJ CODE LST"))]"" D
. S PSOX="",PSOY=1 F I=1:1 S PSOX=$O(PSOREJ(RXCOB,"REJ CODES",I,0)) Q:PSOX="" D
. . S PSOY=PSOY+1,PSOIENS=PSOY_","_PSOIEN
. . S PSOFDA(SFN,"+"_PSOIENS,.01)=PSOX
;
D UPDATE^DIE("","PSOFDA","","PSOERR")
I $D(PSOERR("DIERR")) D BMES^XPDUTL(PSOERR("DIERR",1,"TEXT",1))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOTRI 6265 printed Apr 09, 2024@21:31:27 Page 2
PSOTRI ;BIRM/BNT - OP TRICARE/CHAMPVA Audit Log Utilities ;07/21/2010
+1 ;;7.0;OUTPATIENT PHARMACY;**358,385,427,528**;DEC 1997;Build 10
+2 ;
+3 ; Reference to DUR1^BPSNCPD3 supported by IA 4560
+4 ;
+5 QUIT
+6 ;
+7 ;
AUDIT(RX,RFL,RXCOB,JST,AUD,ELIG) ;
+1 ; Main entry to create a new record in the PSO AUDIT LOG file #52.87
+2 ; Note that AUDIT^PSOTRI is called by ECME (BPSECMP2) - ICR 6156
+3 ; INPUT: RX (r) = Prescription IEN
+4 ; RFL (o) = Prescription Fill # (Default is original zero fill)
+5 ; RXCOB (o) = Coordination of Benefits
+6 ; 1 = Primary (Default)
+7 ; 2 = Secondary
+8 ; JST (o) = Justification text
+9 ; AUD (r) = Audit Type
+10 ; R = NCPDP REJECT - Associated with an Override audit action
+11 ; N = NON BILLABLE - Associated with an Override audit action
+12 ; I = INPATIENT - Associated with a Bypass audit action
+13 ; P = PARTIAL FILL
+14 ; ELIG (r) = Eligibility Type
+15 ; T = TRICARE
+16 ; C = CHAMPVA
+17 ; RETURN: Successful Audit entry will return the IEN of the new entry in file 52.87
+18 ; Unsuccessful Audit entry will return "0^Error Description"
+19 ;
+20 NEW PSOTRIC,PSODIV,RXFLDS,RFLFLDS,RXECME,PSOFDA,FN,SFN,PSOIEN,PSOIENS,PSOUSER,PSOTC,PSOET
+21 NEW I,PSOAIEN,PSOREJ,DFN,PSODOA,PSODOS,PSOERR,PSOX,PSOY,RXARR,RFLARR,PSOPHRM,PSOQTY
+22 NEW PDDATE,PFARR,PFFLDS,PFIEN,PSOPFIEN,PSOUNITCOST
+23 ;
+24 if '$DATA(^PSRX(RX,0))
QUIT "0^Prescription does not exist"
+25 ; Verify refill exists
+26 IF RFL=""!RFL<0
SET RFL=$$LSTRFL^PSOBPSU1(RX)
+27 ;
+28 ; Not original fill
+29 IF RFL
if '$DATA(^PSRX(RX,1,RFL))
QUIT "0^Refill "_RFL_" does not exist"
+30 ;
+31 ; Verify eligibility exists
+32 if ELIG=""
QUIT "0^Eligibiltiy does not exist"
+33 ;
+34 ; Verify Eligibility Type - TRICARE or CHAMPVA patient
+35 IF ("/T/C/")'[("/"_ELIG_"/")
QUIT "0^Invalid Eligibility Type "_ELIG
+36 ; PSOTRIC is used below to determine if there is a eT or eC reject code
+37 SET (PSOTRIC,PSOTC)=""
SET PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,PSOTRIC)
+38 ;
+39 ; Verify Audit Type
+40 IF ("/R/N/I/P/")'[("/"_AUD_"/")
QUIT "0^Invalid Audit Type "_AUD
+41 ;
+42 ; Coordination of Benefits (default is Primary)
+43 SET RXCOB=+$GET(RXCOB)
IF RXCOB=0
SET RXCOB=1
+44 ; Audit File and Reject subfile
+45 SET FN=52.87
SET SFN=52.8713
+46 ;
+47 ; Fields for original fill:
+48 ; PROVIDER;NDC;DRUG NAME;QUANTITY;PATIENT;PATIENT STATUS;PHARMACIST;UNIT PRICE OF DRUG
+49 SET RXFLDS="4;27;6;7;2;3;23;17"
+50 ; Fields for refills
+51 ; PROVIDER;NDC;QUANTITY;PHARMACIST
+52 SET RFLFLDS="15;11;1;4"
+53 ;
+54 ; Get data from RX
+55 DO GETS^DIQ(52,RX,RXFLDS,"I","RXARR")
+56 ; Get data from Refill
+57 IF RFL
DO GETS^DIQ(52.1,RFL_","_RX,RFLFLDS,"I","RFLARR")
+58 ; Get Division
+59 SET PSODIV=$$RXSITE^PSOBPSUT(RX,RFL)
+60 ; ECME Number, if exists
+61 SET RXECME=$$ECMENUM^PSOBPSU2(RX,RFL)
+62 ; Date of Action is NOW
+63 SET PSODOA=$$NOW^XLFDT()
+64 ; Date of Service
+65 SET PSODOS=$$DOS^PSOBPSU1(RX,RFL)
+66 ; User (If null OR Audit Type is Inpatient OR bypass-type reject, set to POSTMASTER)
+67 SET PSOUSER=DUZ
+68 IF (PSOUSER="")!(AUD="I")!$$BYPASS^PSOBPSU1(ELIG,JST)
SET PSOUSER=.5
+69 ; Set up FDA array
+70 SET PSOIEN="+1,"
+71 SET PSOAIEN=$PIECE($GET(^PS(52.87,0)),U,3)+1
+72 ;
+73 ; Quantity, Provider and NDC fields
+74 IF AUD="P"
Begin DoDot:1
+75 ; For Partial Fills pull the QTY, PROVIDER and NDC and from
+76 ; the appropriate entry in the PARTIAL DATE sub-file #52.2.
+77 ; Attempt to identify a partial fill for today's date.
+78 SET PSOPFIEN=""
+79 SET PFIEN=0
FOR
SET PFIEN=$ORDER(^PSRX(RX,"P",PFIEN))
if 'PFIEN
QUIT
SET PDDATE=$PIECE($GET(^PSRX(RX,"P",PFIEN,0)),U,8)
IF $PIECE(PDDATE,".")=$PIECE(PSODOA,".")
SET PSOPFIEN=PFIEN
+80 ; partial fill entry for today not found
+81 IF 'PSOPFIEN
QUIT
+82 ;
+83 ;QTY;CURRENT UNIT PRICE OF DRUG;PROVIDER;NDC
+84 SET PFFLDS=".04;.042;6;1"
+85 DO GETS^DIQ(52.2,PSOPFIEN_","_RX,PFFLDS,"I","PFARR")
+86 SET PSOQTY=$GET(PFARR(52.2,PSOPFIEN_","_RX_",",.04,"I"))
+87 ;Get the UNIT PRICE OF DRUG from the Prescription, the UNIT PRICE isn't stored
+88 ; with the partial fill until later in the processing.
+89 SET PSOUNITCOST=$GET(RXARR(52,RX_",",17,"I"))
+90 ; PROVIDER field
+91 SET PSOFDA(FN,PSOIEN,5)=$GET(PFARR(52.2,PSOPFIEN_","_RX_",",6,"I"))
+92 ; NDC field
+93 SET PSOFDA(FN,PSOIEN,6)=$GET(PFARR(52.2,PSOPFIEN_","_RX_",",1,"I"))
+94 IF PSOFDA(FN,PSOIEN,6)'=""
SET PSOFDA(FN,PSOIEN,6)=$GET(RXARR(52,RX_",",27,"I"))
+95 ; BILL COST field
+96 SET PSOFDA(FN,PSOIEN,8)=(PSOUNITCOST*PSOQTY)+8
End DoDot:1
+97 IF '$TEST
Begin DoDot:1
+98 SET PSOQTY=$SELECT(RFL>0:$GET(RFLARR(52.1,RFL_","_RX_",",1,"I")),1:$GET(RXARR(52,RX_",",7,"I")))
+99 ; PROVIDER field
+100 SET PSOFDA(FN,PSOIEN,5)=$SELECT(RFL>0:$GET(RFLARR(52.1,RFL_","_RX_",",15,"I")),1:$GET(RXARR(52,RX_",",4,"I")))
+101 ; NDC field
+102 SET PSOFDA(FN,PSOIEN,6)=$SELECT(RFL>0:$GET(RFLARR(52.1,RFL_","_RX_",",11,"I")),1:$GET(RXARR(52,RX_",",27,"I")))
+103 ; BILL COST field
+104 ;This needs to be verified
SET PSOFDA(FN,PSOIEN,8)=$GET(RXARR(52,RX_",",17,"I"))*PSOQTY+8
End DoDot:1
+105 ;
+106 ; AUDIT ID field
+107 SET PSOFDA(FN,PSOIEN,.01)=PSOAIEN
+108 ; PRESCRIPTION field
+109 SET PSOFDA(FN,PSOIEN,1)=RX
+110 ; FILL field
+111 SET PSOFDA(FN,PSOIEN,2)=RFL
+112 ; PATIENT field
+113 SET PSOFDA(FN,PSOIEN,3)=$GET(RXARR(52,RX_",",2,"I"))
+114 ; DIVISION field
+115 SET PSOFDA(FN,PSOIEN,4)=PSODIV
+116 ; DRUG field
+117 SET PSOFDA(FN,PSOIEN,7)=$GET(RXARR(52,RX_",",6,"I"))
+118 ; ECME NUMBER field
+119 SET PSOFDA(FN,PSOIEN,9)=RXECME
+120 ; QTY field
+121 SET PSOFDA(FN,PSOIEN,10)=PSOQTY
+122 ; PATIENT STATUS field
+123 SET PSOFDA(FN,PSOIEN,11)=$GET(RXARR(52,RX_",",3,"I"))
+124 ; AUDIT TYPE field
+125 SET PSOFDA(FN,PSOIEN,12)=AUD
+126 ; USER field
+127 SET PSOFDA(FN,PSOIEN,14)=PSOUSER
+128 ; DATE OF ACTION field
+129 SET PSOFDA(FN,PSOIEN,15)=PSODOA
+130 ; DATE OF SERVICE field
+131 SET PSOFDA(FN,PSOIEN,16)=PSODOS
+132 ; TRICARE JUSTIFICATION field
+133 SET PSOFDA(FN,PSOIEN,17)=JST
+134 ; Eligibility Code
+135 SET PSOFDA(FN,PSOIEN,18)=ELIG
+136 ;
+137 DO DUR1^BPSNCPD3(RX,RFL,.PSOREJ,.PSOERR,RXCOB)
+138 ;check to see if eT or eC is the reject code as no ecme claim.
SET PSOET=$$PSOET^PSOREJP3(RX,RFL)
+139 IF PSOET
SET PSOTC=$SELECT(PSOTRIC=1:"eT",PSOTRIC=2:"eC",1:"")
+140 IF PSOTC]""
IF '$DATA(PSOREJ(RXCOB,"REJ CODES"))
SET PSOREJ(RXCOB,"REJ CODES",1,PSOTC)=""
SET PSOREJ(RXCOB,"REJ CODE LST")=PSOTC
+141 IF $GET(PSOREJ(RXCOB,"REJ CODE LST"))]""
Begin DoDot:1
+142 SET PSOX=""
SET PSOY=1
FOR I=1:1
SET PSOX=$ORDER(PSOREJ(RXCOB,"REJ CODES",I,0))
if PSOX=""
QUIT
Begin DoDot:2
+143 SET PSOY=PSOY+1
SET PSOIENS=PSOY_","_PSOIEN
+144 SET PSOFDA(SFN,"+"_PSOIENS,.01)=PSOX
End DoDot:2
End DoDot:1
+145 ;
+146 DO UPDATE^DIE("","PSOFDA","","PSOERR")
+147 IF $DATA(PSOERR("DIERR"))
DO BMES^XPDUTL(PSOERR("DIERR",1,"TEXT",1))
+148 QUIT
