Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOREJU2

PSOREJU2.m

Go to the documentation of this file.
  1. PSOREJU2 ;BIRM/MFR - BPS (ECME) - Clinical Rejects Utilities (1) ;10/15/04
  1. ;;7.0;OUTPATIENT PHARMACY;**148,260,287,341,290,358,359,385,403,421,427,478,562,680,681,702,704**;DEC 1997;Build 16
  1. ; Reference to $$TAXID^IBCEF75 in ICR #6768
  1. ; Reference to $$DIVNCPDP^BPSBUTL in ICR #4719
  1. ; Reference to File 9002313.23 - BPS NCPDP REASON FOR SERVICE CODE in ICR #4714
  1. ; Reference to File 9002313.26 - BPS NCPDP PRIOR AUTHORIZATION TYPE CODE in ICR #5585
  1. ; Reference to $$CSNPI^BPSUTIL in ICR #4146
  1. ;
  1. GET(RX,RFL,REJDATA,REJID,OKCL,CODE,RRRFLG) ; get reject data from subfile 52.25
  1. ; Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (r) REJDATA(REJECT IEN,FIELD) - Array where these Reject fields will be returned:
  1. ; "BIN" - Payer BIN number
  1. ; "PCN" - Processor Control Number
  1. ; "CODE" - Reject Code (79 or 88 or 943)
  1. ; "DATE/TIME" - DATE/TIME Reject was detected
  1. ; "PAYER MESSAGE" - Message returned by the payer
  1. ; "REASON" - Reject Reason description (from payer)
  1. ; "INSURANCE NAME" - Patient's Insurance Company Name
  1. ; "INSURANCE POINTER" - Patient Insurance Company Pointer
  1. ; "COB" - Coordination of Benefits
  1. ; "GROUP NAME" - Patient's Insurance Group Name
  1. ; "GROUP NUMBER" - Patient's Insurance Group Number
  1. ; "CARDHOLDER ID" - Patient's Insurance Cardholder ID
  1. ; "PLAN CONTACT" - Plan's Contact (eg., "1-800-...")
  1. ; "PLAN PREVIOUS FILL DATE" - Last time Rx was paid by payer
  1. ; "STATUS" - REJECTS status ("OPEN/UNRESOLVED" or "CLOSED/RESOLVED")
  1. ; "DUR TEXT" - Payer's DUR description
  1. ; "DUR ADD MSG TEXT" - Payer's DUR additional description
  1. ; "OTHER REJECTS" - Other Rejects on the same response
  1. ; "REASON SVC CODE" - Reason for Service Code
  1. ; If REJECT is closed, the following fields will be returned:
  1. ; "CLA CODE" - Clarification Code submitted
  1. ; "PRIOR AUTH TYPE" - Prior Authorization Type
  1. ; "PRIOR AUTH NUMBER" - Prior Authorization Type
  1. ; "CLOSED DATE/TIME" - DATE/TIME Reject was closed
  1. ; "CLOSED BY" - Name of the user responsible for closing Reject
  1. ; "CLOSE REASON" - Reason for closing Reject (text)
  1. ; "CLOSE COMMENTS" - User entered comments at close
  1. ; (o) REJID - REJECT IEN in the PRESCRIPTION file for retrieve this REJECT
  1. ; (o) OKCL - If set to 1, CLOSED REJECTs will also be returned
  1. ; (o) CODE - Only REJECTs with this CODE should be returned
  1. ; (o) RRRFLG - If set to 1 with CODE present, also return Reject Resolution Required REJECTs
  1. ; If set to 1 and CODE not passed, then only return RRR REJECTs
  1. ;
  1. N ARRAY,COM,IDX,REJFLD,REJS,Z
  1. ;
  1. I '$D(RFL) S RFL=$$LSTRFL^PSOBPSU1(RX)
  1. S RFL=+$G(RFL)
  1. ;
  1. K REJDATA
  1. I '$O(^PSRX(RX,"REJ",0)) Q
  1. ;
  1. K REJS
  1. I $G(REJID) D
  1. . I +$P($G(^PSRX(RX,"REJ",REJID,0)),"^",4)'=RFL Q
  1. . I '$G(OKCL),$P($G(^PSRX(RX,"REJ",REJID,0)),"^",5) Q
  1. . S REJS(REJID)=""
  1. E D
  1. . S IDX="A"
  1. . F S IDX=$O(^PSRX(RX,"REJ",IDX),-1) Q:'IDX D
  1. . . I +$P($G(^PSRX(RX,"REJ",IDX,0)),"^",4)'=RFL Q
  1. . . I '$G(OKCL),$P($G(^PSRX(RX,"REJ",IDX,0)),"^",5) Q
  1. . . S REJS(IDX)=""
  1. I '$D(REJS) Q
  1. ;
  1. S IDX=0
  1. F S IDX=$O(REJS(IDX)) Q:'IDX D
  1. . N SKIP
  1. . K ARRAY D GETS^DIQ(52.25,IDX_","_RX_",","*","","ARRAY")
  1. . K REJFLD M REJFLD=ARRAY(52.25,IDX_","_RX_",")
  1. . ;
  1. . ; check CODE and RRRFLG to see if we want this reject data
  1. . S SKIP=0 ; default is to include it
  1. . I $G(CODE)'="",REJFLD(.01)'=CODE S SKIP=1 ; CODE exists and doesn't match this reject
  1. . I SKIP,$G(RRRFLG),$G(REJFLD(30))="YES" S SKIP=0 ; but include these if RRRFLG is true and this is an RRR reject
  1. . I $G(CODE)="",$G(RRRFLG),$G(REJFLD(30))'="YES" S SKIP=1 ; want only RRR rejects in this case
  1. . I SKIP Q ; get out if we're skipping this one
  1. . ;
  1. . S REJDATA(IDX,"CODE")=$G(REJFLD(.01))
  1. . S REJDATA(IDX,"DATE/TIME")=$G(REJFLD(1))
  1. . S REJDATA(IDX,"PAYER MESSAGE")=$G(REJFLD(2))
  1. . S REJDATA(IDX,"REASON")=$G(REJFLD(3))
  1. . S REJDATA(IDX,"PHARMACIST")=$G(REJFLD(4))
  1. . S REJDATA(IDX,"INSURANCE NAME")=$G(REJFLD(20))
  1. . S REJDATA(IDX,"INSURANCE POINTER")=$G(REJFLD(33)) ;PSO*427
  1. . S REJDATA(IDX,"COB")=$G(REJFLD(27))
  1. . S REJDATA(IDX,"GROUP NAME")=$G(REJFLD(6))
  1. . S REJDATA(IDX,"GROUP NUMBER")=$G(REJFLD(21))
  1. . S REJDATA(IDX,"BIN")=$G(REJFLD(29))
  1. . S REJDATA(IDX,"PCN")=$G(REJFLD(34))
  1. . S REJDATA(IDX,"CARDHOLDER ID")=$G(REJFLD(22))
  1. . S REJDATA(IDX,"PLAN CONTACT")=$G(REJFLD(7))
  1. . S REJDATA(IDX,"PLAN PREVIOUS FILL DATE")=$G(REJFLD(8))
  1. . S REJDATA(IDX,"STATUS")=$G(REJFLD(9))
  1. . S REJDATA(IDX,"OTHER REJECTS")=$G(REJFLD(17))
  1. . S REJDATA(IDX,"DUR TEXT")=$G(REJFLD(18))
  1. . S REJDATA(IDX,"DUR ADD MSG TEXT")=$G(REJFLD(28))
  1. . S REJDATA(IDX,"REASON SVC CODE")=$G(REJFLD(14))
  1. . S REJDATA(IDX,"RESPONSE IEN")=$G(REJFLD(16))
  1. . S REJDATA(IDX,"RRR FLAG")=$G(REJFLD(30)) ;PSO*421
  1. . S REJDATA(IDX,"RRR THRESHOLD AMT")=$G(REJFLD(31)) ;PSO*421
  1. . S REJDATA(IDX,"RRR GROSS AMT DUE")=$G(REJFLD(32)) ;PSO*421
  1. . I '$G(OKCL) Q
  1. . S REJDATA(IDX,"CLOSED DATE/TIME")=$G(REJFLD(10))
  1. . S REJDATA(IDX,"CLOSED BY")=$G(REJFLD(11))
  1. . S REJDATA(IDX,"CLOSE REASON")=$G(REJFLD(12))
  1. . S REJDATA(IDX,"CLOSE COMMENTS")=$G(REJFLD(13))
  1. . S REJDATA(IDX,"COD1")=$G(REJFLD(14))
  1. . S REJDATA(IDX,"COD2")=$G(REJFLD(15))
  1. . S REJDATA(IDX,"COD3")=$G(REJFLD(19))
  1. . S REJDATA(IDX,"CLA CODE")=$G(REJFLD(24))
  1. . S REJDATA(IDX,"PRIOR AUTH TYPE")=$G(REJFLD(25))
  1. . S REJDATA(IDX,"PRIOR AUTH NUMBER")=$G(REJFLD(26))
  1. . S COM=0 F S COM=$O(^PSRX(RX,"REJ",IDX,"COM",COM)) Q:'COM D
  1. . . S Z=^PSRX(RX,"REJ",IDX,"COM",COM,0)
  1. . . S REJDATA(IDX,"COMMENTS",COM,"DATE/TIME")=$P(Z,"^")
  1. . . S REJDATA(IDX,"COMMENTS",COM,"USER")=$P(Z,"^",2)
  1. . . S REJDATA(IDX,"COMMENTS",COM,"COMMENTS")=$P(Z,"^",3)
  1. Q
  1. ;
  1. HELP(OPTS) ; Display the Help Text for the DUR handling options (OVERRIDE/IGNORE/STOP/QUIT)
  1. ;
  1. I OPTS["O" D
  1. . W !?1,"(O)verride - This option will provide the prompts for the code sets needed to"
  1. . W !?1," override this reject and get a payable 3rd party claim. Before"
  1. . W !?1," you select this option, you may need to call the 3rd party payer"
  1. . W !?1," to determine which code sets are needed to override a particular"
  1. . W !?1," reject. Once the proper override is accepted the label will print"
  1. . W !?1," and the prescription can be filled."
  1. ;
  1. I OPTS["I" D
  1. . W !?1,"(I)gnore - Choosing Ignore will by-pass 3rd party processing and will allow"
  1. . W !?1," you to print a label and fill the prescription. This essentially"
  1. . W !?1," ignores the clinical safety issues suggested by the 3rd party"
  1. . W !?1," payer and will NOT result in a payable claim."
  1. ;
  1. I OPTS["Q" D
  1. . W !?1,"(Q)uit - Choosing Quit will postpone the processing of this prescription"
  1. . W !?1," until this 3rd party reject is resolved. A label will not be"
  1. . W !?1," printed for this prescription and it can not be filled/dispensed"
  1. . W !?1," until this reject is resolved. Rejects can be resolved through"
  1. . W !?1," the Worklist option under the ePharmacy menu."
  1. Q
  1. ;
  1. DVINFO(RX,RFL,LM) ; Returns header displayable Division Information
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) RFL - Refill # (Default: most recent)
  1. ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
  1. N DVIEN,DVINFO,NCPNPI,PSOTAXID,TXT
  1. S DVIEN=+$$RXSITE^PSOBPSUT(RX,RFL)
  1. S DVINFO="Division : "_$E($$GET1^DIQ(59,DVIEN,.01),1,15)
  1. ;
  1. ; Check for Controlled Substance Drug and if a BPS Pharmacy for CS has
  1. ; been defined. If so, use NCPDP# & NPI for the CS Pharmacy.
  1. S NCPNPI=$$CSNPI^BPSUTIL(RX,RFL)
  1. ;
  1. ; If not a Controlled Substance, use NCPDP# & NPI info based on Division.
  1. ; Display both NPI and NCPDP numbers
  1. I +NCPNPI=-1 S NCPNPI=$$DIVNCPDP^BPSBUTL(DVIEN)
  1. S $E(DVINFO,28)="NPI: "_$P(NCPNPI,U,2)
  1. S $E(DVINFO,44)="NCPDP: "_$P(NCPNPI,U)
  1. S PSOTAXID=$P($$TAXID^IBCEF75,U,2) ; IA 6768
  1. S $E(DVINFO,62)="TAX ID: "_$E(PSOTAXID,1,2)_"-"_$E(PSOTAXID,3,$L(PSOTAXID))
  1. Q DVINFO
  1. ;
  1. PTINFO(RX,LM) ; Returns header displayable Patient Information
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (o) LM - ListManager format? (1 - Yes / 0 - No) - Default: 0
  1. N DFN,VADM,PTINFO,SEX,SSN4
  1. S DFN=$$GET1^DIQ(52,RX,2,"I")
  1. D DEM^VADPT
  1. S SSN4=$P($G(VADM(2)),"^",2)
  1. S PTINFO="Patient : "_$E($G(VADM(1)),1,$S($G(LM):24,1:20))_"("_$E(SSN4,$L(SSN4)-3,$L(SSN4))_")"
  1. S $E(PTINFO,$S($G(LM):61,1:54))="DOB: "_$P($G(VADM(3)),"^",2)_"("_$P($G(VADM(4)),"^")_")"
  1. S SEX="Birth Sex: "_$P($G(VADM(5)),"^")
  1. S $E(SEX,28)="Self-Identified Gender: "_$E($P($G(VADM(14,5)),U,1),1,24)
  1. Q PTINFO_U_SEX
  1. ;
  1. RETRXF(RX,RFL,ONOFF) ; - Set/Reset the Re-transmission flag
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (r) RFL - Refill IEN (#52.1)
  1. ; (o) ONOFF - Turn flag ON or OFF (1 - ON / 0 - OFF) (Default: OFF)
  1. I RFL>0,'$D(^PSRX(RX,1,RFL,0)) QUIT
  1. N DA,DIE,DR
  1. S DR="82///"_$S($G(ONOFF):"YES",1:"@")
  1. I 'RFL S DA=RX,DIE="^PSRX("
  1. I RFL S DA(1)=RX,DA=RFL,DIE="^PSRX("_RX_",1,"
  1. D ^DIE
  1. Q
  1. ;
  1. REASON(TXT) ; Extracts the Reason for service code from the REASON text field
  1. ; Input: (r) TXT - Reason text (e.g., NN Reason for Service Code Text)
  1. ;Output: REASON - NN (if on valid and on file (#9002313.23), null otherwise)
  1. N REASON,DIC,X,Y
  1. S REASON=$P(TXT," ") I $L(REASON)'=2 Q ""
  1. S DIC=9002313.23,X=REASON D ^DIC I Y<0 Q ""
  1. Q REASON
  1. ;
  1. SETOPN(RX,REJ) ; - Set the Reject RE-OPENED flag to YES
  1. ;Input: (r) RX - Rx IEN (#52)
  1. ; (r) REJ - Reject IEN (#52.25)
  1. ;
  1. I '$D(^PSRX(RX,"REJ",REJ)) Q
  1. N DIE,DA,DR
  1. S DIE="^PSRX("_RX_",""REJ"",",DA(1)=RX,DA=REJ,DR="23///YES" D ^DIE
  1. Q
  1. ;
  1. PRT(FIELD,P,L) ; Sets the lines for fields that require text wrapping
  1. ;Input: FIELD - Subscript name from the DATA(REJ,FIELD) array
  1. ; P - Position where the content should be printed
  1. ; L - Lenght of the text on each line
  1. N TXT,I
  1. S TXT=DATA(REJ,FIELD) I $L(TXT)'>L W ?P,TXT Q
  1. F I=1:1 Q:TXT="" D
  1. . I I=1 W ?P,$E(TXT,1,L),! S TXT=$E(TXT,L+1,999) Q
  1. . W ?P,$E(TXT,1,L) S TXT=$E(TXT,L+1,999) W:TXT'="" !
  1. Q
  1. ;
  1. PA() ; - Ask for Prior Authorization Type and Number
  1. ; Called by PA^PSOREJP1 (PA acton) and SMA^PSOREJP1 (SMA action)
  1. ;
  1. ;Output:(PAT^PAN) PAT - Prior Authorization Type
  1. ; (See DD File #9002313.26 for possible values)
  1. ; PAN - Prior Authorization Number (11 digits)
  1. ;
  1. N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,PAN,PAT,X,Y
  1. S DIC("B")=0
  1. S DIC(0)="QEAM",DIC=9002313.26,DIC("A")="Prior Authorization Type: "
  1. S DIC("S")="I $P($G(^(0)),""^"",3)'=1"
  1. D ^DIC
  1. I ($D(DUOUT))!($D(DTOUT))!(Y=-1) Q "^" ;Check for "^" or timeout
  1. S PAT=$P(Y,U,2)
  1. ;
  1. K DIR,DIC,X,Y
  1. S DIR(0)="52.25,26",DIR("A")="Prior Authorization Number"
  1. S DIR("?")="^D PANHLP^PSOREJU2",DIR("??")=""
  1. D ^DIR I (Y["^")!$D(DTOUT) Q "^"
  1. S PAN=Y
  1. Q (PAT_"^"_PAN)
  1. ;
  1. PANHLP ; Prior Authorization Number Help
  1. W "OR you may leave it blank if the claim does not require a number."
  1. Q