- 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 Jan 18, 2025@03:37:09 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