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