PSOREJP5 ;ALB/BNT - Third Party Reject Additional Reject Information Screen ;02/14/11
;;7.0;OUTPATIENT PHARMACY;**359,421,512,528,560,561**;DEC 1997;Build 41
;
; Reference to $$BBILL^BPSBUTL and $$RESUBMIT^BPSBUTL supported by IA 4719
; Reference to BPSNCPD3 supported by IA 4560
;
EN ; -- main entry point for PSO REJECT DISPLAY ADDTNL INFO
D EN^VALM("PSO REJECT DISPLAY ADDTNL INFO")
Q
;
ADDTXT ; Entry point for DUR Hidden action
I '$D(@(VALMAR)) Q
N FILL,LASTLN
S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
D FULL^VALM1
D EN
Q
;
ISDUR(RX,REJ) ;
; Returns 1 if there is DUR PPS RESPONSE data for the reject
I '$G(RX) Q 0
I '$G(REJ) Q 0
N RXCOB,DURPPS,DURIEN
S DURIEN=$$RESPIEN(RX,REJ)
Q:DURIEN="" 0
S RXCOB=$$RXCOB(RX,REJ)
I RXCOB="" S RXCOB=1
D DURRESP^BPSNCPD3(DURIEN,.DURPPS,RXCOB)
I $G(DURPPS(RXCOB,"DUR PPS RESPONSE"))!($G(DURPPS(RXCOB,"MESSAGE"))]"")!($G(DURPPS(RXCOB,"PAYER MESSAGE",1))]"") Q 1
Q 0
;
HDR ; -- header code
N LINE1,LINE2,X
S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1),VALMHDR(2)=$$PTINFO^PSOREJU2(RX,1)
;cnf, PSO*7*358, add REJ to parameter list for RXINFO^PSOREJP3
S VALMHDR(3)=$$RXINFO^PSOREJP3(RX,FILL,1),VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ)
Q
;
INIT ; -- init variables and list array
N ADDREJ,DATA,DURIEN,I,LINE,NDX,RXCOB,X
F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
K ^TMP("PSOREJP2",$J) S VALMCNT=0,LINE=0
S DURIEN=$$RESPIEN(RX,REJ)
Q:DURIEN=""
S RXCOB=$$RXCOB(RX,REJ)
D DURRESP^BPSNCPD3(DURIEN,.ADDREJ,RXCOB)
I '+$G(ADDREJ(RXCOB,"DUR PPS RESPONSE")),$G(ADDREJ(RXCOB,"MESSAGE"))']"",$G(ADDREJ(RXCOB,"PAYER MESSAGE",1))="" D Q
. D SETLN()
. D SETLN("There is no additional reject information to display")
;
D SETLN()
D SET("MESSAGE",80-$L($$LABEL("MESSAGE")),"",ADDREJ(RXCOB,"MESSAGE"))
;
D SETLN()
D SET("PAYER ADDL MSG",80-$L($$LABEL("PAYER ADDL MSG")),"",$G(ADDREJ(RXCOB,"PAYER MESSAGE",1)))
S X="",$E(X,$L($$LABEL("PAYER ADDL MSG")))=" "
S I=1 F S I=$O(ADDREJ(RXCOB,"PAYER MESSAGE",I)) Q:'I D
. D SET("",80-$L($$LABEL("PAYER ADDL MSG")),"",X_ADDREJ(RXCOB,"PAYER MESSAGE",I))
;
D BPSRESP^PSOREJP6(DURIEN)
;
S NDX=""
F S NDX=$O(ADDREJ(RXCOB,"DUR PPS",NDX)) Q:NDX="" D
. N QPF
. D SETLN()
. D SET("DUR PPS RESPONSE",80-$L($$LABEL("DUR PPS RESPONSE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR PPS RESPONSE"))
. D SET("REASON FOR SERVICE CODE",80-$L($$LABEL("REASON FOR SERVICE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"REASON FOR SERVICE CODE"))
. D SET("CLINICAL SIGNIFICANCE CODE",80-$L($$LABEL("CLINICAL SIGNIFICANCE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"CLINICAL SIGNIFICANCE CODE"))
. D SET("OTHER PHARMACY INDICATOR",80-$L($$LABEL("OTHER PHARMACY INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PHARMACY INDICATOR"))
. D SET("PREVIOUS DATE OF FILL",80-$L($$LABEL("PREVIOUS DATE OF FILL")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"PREVIOUS DATE OF FILL"))
. ;
. ; esg - PSO*7*421 - 2/4/13 - properly display Quantity of Previous Fill
. S QPF=""
. I ADDREJ(RXCOB,"DUR PPS",NDX,"QUANTITY OF PREVIOUS FILL") S QPF=ADDREJ(RXCOB,"DUR PPS",NDX,"QUANTITY OF PREVIOUS FILL")/1000
. D SET("QUANTITY OF PREVIOUS FILL",80-$L($$LABEL("QUANTITY OF PREVIOUS FILL")),"",QPF)
. ;
. D SET("DATABASE INDICATOR",80-$L($$LABEL("DATABASE INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DATABASE INDICATOR"))
. D SET("OTHER PRESCRIBER INDICATOR",80-$L($$LABEL("OTHER PRESCRIBER INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PRESCRIBER INDICATOR"))
. D SET("DUR FREE TEXT MESSAGE",80-$L($$LABEL("DUR FREE TEXT MESSAGE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR FREE TEXT MESSAGE"))
. D SET("DUR ADDITIONAL TEXT",80-$L($$LABEL("DUR ADDITIONAL TEXT")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR ADDITIONAL TEXT"))
S VALMCNT=LINE
Q
;
LABEL(FIELD) ; Sets the label for the field
I FIELD="MESSAGE" Q "Payer Msg: "
I FIELD="PAYER ADDL MSG" Q "Payer Addl Msg: "
I FIELD="DUR PPS RESPONSE" Q "DUR Response: "
I FIELD="REASON FOR SERVICE CODE" Q "Reason Code: "
I FIELD="CLINICAL SIGNIFICANCE CODE" Q "Clinical Significance Code: "
I FIELD="OTHER PHARMACY INDICATOR" Q "Other Pharmacy Indicator: "
I FIELD="PREVIOUS DATE OF FILL" Q "Previous Date of Fill: "
I FIELD="QUANTITY OF PREVIOUS FILL" Q "Quantity of Previous Fill: "
I FIELD="DATABASE INDICATOR" Q "Database Indicator: "
I FIELD="OTHER PRESCRIBER INDICATOR" Q "Other Prescriber Indicator: "
I FIELD="DUR FREE TEXT MESSAGE" Q "DUR Text: "
I FIELD="DUR ADDITIONAL TEXT" Q "DUR Add Text: "
I FIELD="INVALID PROVIDER DATA SOURCE" Q "Invalid Provider Data Source: "
I FIELD="FORMULARY ALTERNATIVE EFF DATE" Q "Formulary Alternative Eff Date: "
I FIELD="DUR/DUE CO-AGENT DESCRIPTION" Q "DUR/DUE Co-Agent Description: "
I FIELD="UNIT OF PRIOR DISPENSED QTY" Q "Unit of Prior Dispensed Quantity: "
I FIELD="OTHER PHARMACY ID QUALIFIER" Q "Other Pharmacy ID Qualifier: "
I FIELD="OTHER PHARMACY NAME" Q "Other Pharmacy Name: "
I FIELD="OTHER PHARMACY TELEPHONE" Q "Other Pharmacy Telephone: "
I FIELD="OTHER PRESCRIBER LAST NAME" Q "Other Prescriber Last Name: "
I FIELD="OTHER PRESCRIBER ID QUALIFIER" Q "Other Prescriber ID Qualifier: "
I FIELD="OTHER PRESCRIBER ID" Q "Other Prescriber ID: "
I FIELD="OTHER PRESCRIBER PHONE NUMBER" Q "Other Prescriber Phone Number: "
I FIELD="DUR/DUE COMPOUND PRODUCT ID" Q "DUR/DUE Compound Product ID: "
I FIELD="DUR/DUE CMPND PRDUCT ID QUALIF" Q "DUR/DUE Compound Product ID Qualifier: "
I FIELD="DUR/DUE MAXIMUM DAILY DOSE QTY" Q "DUR/DUE Maximum Daily Dose Quantity: "
I FIELD="DUR/DUE MAX DAILY DOSE - UNIT" Q "DUR/DUE Maximum Daily Dose Unit: "
I FIELD="DUR/DUE MINIMUM DAILY DOSE QTY" Q "DUR/DUE Minimum Daily Dose Quantity: "
I FIELD="DUR/DUE MIN DAILY DOSE - UNIT" Q "DUR/DUE Minimum Daily Dose Unit: "
Q ""
;
SET(FIELD,L,UND,TXT) ; Sets the lines for fields that require text wrapping
N I,T
I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q
F I=1:1 Q:TXT="" D
. I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q
. S T="",$E(T,81-L)=$E(TXT,1,L) D SETLN(T,,$S($E(TXT,L+1,999)=""&$G(UND):1,1:0),80-L) S TXT=$E(TXT,L+1,999)
Q
;
SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section
N X
S:$G(TEXT)="" $E(TEXT,80)=""
S:$L(TEXT)>80 TEXT=$E(TEXT,1,80)
S LINE=LINE+1,^TMP("PSOREJP2",$J,LINE,0)=$G(TEXT)
;
I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE
;
I $G(REV) D Q
. D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM)
. I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM)
I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
I $G(HIG) D
. D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM)
Q
;
RXCOB(RX,REJ) ; Return the COB Indicator for the reject
; Input: RX = RX IEN
; REJ = Reject Info multiple IEN
I '$G(RX) Q ""
I '$G(REJ) Q ""
N RXCOB
S RXCOB=$$GET1^DIQ(52.25,REJ_","_RX_",","27","I")
Q $S(+RXCOB>1:RXCOB,1:1)
;
RESPIEN(RX,REJ) ; Return the RESPONSE ID from the Reject Info multiple
; Input: RX = RX IEN
; REJ = Reject Info multiple IEN
I '$G(RX) Q ""
I '$G(REJ) Q ""
Q $$GET1^DIQ(52.25,REJ_","_RX_",","16","I")
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
REJ ; - DUR Information - called from REJ^PSOREJP1
; this code moved from PSOREJP1, routine was too large
;
S PSONAF=$$NFLDT^BPSBUTL(RX,FILL) ; IA 4719
I PSONAF'="" D SETLN^PSOREJP1("Next Avail Fill: "_$$FMTE^XLFDT(PSONAF),,,16) ; PSO*7*421
S PSOADD=$$ADDFLDS^BPSBUTL(RX,FILL,PSOCOB) ; IA 4719
I $P(PSOADD,U)'="" D SETLN^PSOREJP1("Maximum Age Qualifier: "_$P(PSOADD,U),,,22)
I $P(PSOADD,U,2)'="" D SETLN^PSOREJP1("Maximum Age: "_$P(PSOADD,U,2),,,12)
I $P(PSOADD,U,3)'="" D SETLN^PSOREJP1("Maximum Amount: "_$P(PSOADD,U,3),,,15)
I $P(PSOADD,U,4)'="" D SETLN^PSOREJP1("Maximum Amount Qualifier: "_$P(PSOADD,U,4),,,25)
I $P(PSOADD,U,5)'="" D SETLN^PSOREJP1("Maximum Amount Time Period: "_$P(PSOADD,U,5),,,27)
I $P(PSOADD,U,6)'="" D SETLN^PSOREJP1("Maximum Amount Time Period Start Date: "_$$FMTE^XLFDT($P(PSOADD,U,6)),,,38)
I $P(PSOADD,U,7)'="" D SETLN^PSOREJP1("Maximum Amount Time Period End Date: "_$$FMTE^XLFDT($P(PSOADD,U,7)),,,36)
I $P(PSOADD,U,8)'="" D SETLN^PSOREJP1("Maximum Amount Time Period Units: "_$P(PSOADD,U,8),,,33)
I $P(PSOADD,U,9)'="" D SETLN^PSOREJP1("Minimum Age Qualifier: "_$P(PSOADD,U,9),,,22)
I $P(PSOADD,U,10)'="" D SETLN^PSOREJP1("Minimum Age: "_$P(PSOADD,U,10),,,12)
I $P(PSOADD,U,11)'="" D SETLN^PSOREJP1("Minimum Amount: "_$P(PSOADD,U,11),,,15)
I $P(PSOADD,U,12)'="" D SETLN^PSOREJP1("Minimum Amount Qualifier: "_$P(PSOADD,U,12),,,25)
I $P(PSOADD,U,13)'="" D SETLN^PSOREJP1("Remaining Amount: "_$P(PSOADD,U,13),,,17)
I $P(PSOADD,U,14)'="" D SETLN^PSOREJP1("Remaining Amount Qualifier: "_$P(PSOADD,U,14),,,27)
;
D SET^PSOREJP1("PAYER MESSAGE",63)
D SET^PSOREJP1("REASON",63)
S PFLDT=$$FMTE^XLFDT($G(DATA(REJ,"PLAN PREVIOUS FILL DATE")))
D SET^PSOREJP1("DUR TEXT",63,$S(PFLDT="":1,1:0))
I PFLDT'="" D SETLN^PSOREJP1("Last Fill Date : "_PFLDT_" (from payer)",,1,18)
Q
;
PSOETEC(RX,FILL) ; Returns flag for TRICARE or CHAMPVA non-billable claims
;This function is used to determine how a claim is stored in the PSO AUDIT LOG (file #56.87),
;it is not necessary to check to see if the claim has a reject that is resolved or unresolved
; Returns: 1 - if rejection code is eT or eC (pseudo-reject code) / 0 - otherwise
N PSOQ,PSRXIEN
I '$G(RX) Q 0
I $D(^PSRX(RX,"REJ","B","eT")) D Q PSOQ
. S PSRXIEN=0
. S PSOQ=1
. F S PSRXIEN=$O(^PSRX(RX,"REJ","B","eT",PSRXIEN)) Q:'PSRXIEN D
. . I $$GET1^DIQ(52.25,PSRXIEN_","_RX,2)["NOT INSURED" S PSOQ=0
I $D(^PSRX(RX,"REJ","B","eC")) D Q PSOQ
. S PSRXIEN=0
. S PSOQ=1
. F S PSRXIEN=$O(^PSRX(RX,"REJ","B","eC",PSRXIEN)) Q:'PSRXIEN D
. . I $$GET1^DIQ(52.25,PSRXIEN_","_RX,2)["NOT INSURED" S PSOQ=0
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREJP5 9958 printed Apr 09, 2024@21:25:54 Page 2
PSOREJP5 ;ALB/BNT - Third Party Reject Additional Reject Information Screen ;02/14/11
+1 ;;7.0;OUTPATIENT PHARMACY;**359,421,512,528,560,561**;DEC 1997;Build 41
+2 ;
+3 ; Reference to $$BBILL^BPSBUTL and $$RESUBMIT^BPSBUTL supported by IA 4719
+4 ; Reference to BPSNCPD3 supported by IA 4560
+5 ;
EN ; -- main entry point for PSO REJECT DISPLAY ADDTNL INFO
+1 DO EN^VALM("PSO REJECT DISPLAY ADDTNL INFO")
+2 QUIT
+3 ;
ADDTXT ; Entry point for DUR Hidden action
+1 IF '$DATA(@(VALMAR))
QUIT
+2 NEW FILL,LASTLN
+3 SET FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
+4 DO FULL^VALM1
+5 DO EN
+6 QUIT
+7 ;
ISDUR(RX,REJ) ;
+1 ; Returns 1 if there is DUR PPS RESPONSE data for the reject
+2 IF '$GET(RX)
QUIT 0
+3 IF '$GET(REJ)
QUIT 0
+4 NEW RXCOB,DURPPS,DURIEN
+5 SET DURIEN=$$RESPIEN(RX,REJ)
+6 if DURIEN=""
QUIT 0
+7 SET RXCOB=$$RXCOB(RX,REJ)
+8 IF RXCOB=""
SET RXCOB=1
+9 DO DURRESP^BPSNCPD3(DURIEN,.DURPPS,RXCOB)
+10 IF $GET(DURPPS(RXCOB,"DUR PPS RESPONSE"))!($GET(DURPPS(RXCOB,"MESSAGE"))]"")!($GET(DURPPS(RXCOB,"PAYER MESSAGE",1))]"")
QUIT 1
+11 QUIT 0
+12 ;
HDR ; -- header code
+1 NEW LINE1,LINE2,X
+2 SET VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1)
SET VALMHDR(2)=$$PTINFO^PSOREJU2(RX,1)
+3 ;cnf, PSO*7*358, add REJ to parameter list for RXINFO^PSOREJP3
+4 SET VALMHDR(3)=$$RXINFO^PSOREJP3(RX,FILL,1)
SET VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ)
+5 QUIT
+6 ;
INIT ; -- init variables and list array
+1 NEW ADDREJ,DATA,DURIEN,I,LINE,NDX,RXCOB,X
+2 FOR I=1:1:$GET(LASTLN)
DO RESTORE^VALM10(I)
+3 KILL ^TMP("PSOREJP2",$JOB)
SET VALMCNT=0
SET LINE=0
+4 SET DURIEN=$$RESPIEN(RX,REJ)
+5 if DURIEN=""
QUIT
+6 SET RXCOB=$$RXCOB(RX,REJ)
+7 DO DURRESP^BPSNCPD3(DURIEN,.ADDREJ,RXCOB)
+8 IF '+$GET(ADDREJ(RXCOB,"DUR PPS RESPONSE"))
IF $GET(ADDREJ(RXCOB,"MESSAGE"))']""
IF $GET(ADDREJ(RXCOB,"PAYER MESSAGE",1))=""
Begin DoDot:1
+9 DO SETLN()
+10 DO SETLN("There is no additional reject information to display")
End DoDot:1
QUIT
+11 ;
+12 DO SETLN()
+13 DO SET("MESSAGE",80-$LENGTH($$LABEL("MESSAGE")),"",ADDREJ(RXCOB,"MESSAGE"))
+14 ;
+15 DO SETLN()
+16 DO SET("PAYER ADDL MSG",80-$LENGTH($$LABEL("PAYER ADDL MSG")),"",$GET(ADDREJ(RXCOB,"PAYER MESSAGE",1)))
+17 SET X=""
SET $EXTRACT(X,$LENGTH($$LABEL("PAYER ADDL MSG")))=" "
+18 SET I=1
FOR
SET I=$ORDER(ADDREJ(RXCOB,"PAYER MESSAGE",I))
if 'I
QUIT
Begin DoDot:1
+19 DO SET("",80-$LENGTH($$LABEL("PAYER ADDL MSG")),"",X_ADDREJ(RXCOB,"PAYER MESSAGE",I))
End DoDot:1
+20 ;
+21 DO BPSRESP^PSOREJP6(DURIEN)
+22 ;
+23 SET NDX=""
+24 FOR
SET NDX=$ORDER(ADDREJ(RXCOB,"DUR PPS",NDX))
if NDX=""
QUIT
Begin DoDot:1
+25 NEW QPF
+26 DO SETLN()
+27 DO SET("DUR PPS RESPONSE",80-$LENGTH($$LABEL("DUR PPS RESPONSE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR PPS RESPONSE"))
+28 DO SET("REASON FOR SERVICE CODE",80-$LENGTH($$LABEL("REASON FOR SERVICE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"REASON FOR SERVICE CODE"))
+29 DO SET("CLINICAL SIGNIFICANCE CODE",80-$LENGTH($$LABEL("CLINICAL SIGNIFICANCE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"CLINICAL SIGNIFICANCE CODE"))
+30 DO SET("OTHER PHARMACY INDICATOR",80-$LENGTH($$LABEL("OTHER PHARMACY INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PHARMACY INDICATOR"))
+31 DO SET("PREVIOUS DATE OF FILL",80-$LENGTH($$LABEL("PREVIOUS DATE OF FILL")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"PREVIOUS DATE OF FILL"))
+32 ;
+33 ; esg - PSO*7*421 - 2/4/13 - properly display Quantity of Previous Fill
+34 SET QPF=""
+35 IF ADDREJ(RXCOB,"DUR PPS",NDX,"QUANTITY OF PREVIOUS FILL")
SET QPF=ADDREJ(RXCOB,"DUR PPS",NDX,"QUANTITY OF PREVIOUS FILL")/1000
+36 DO SET("QUANTITY OF PREVIOUS FILL",80-$LENGTH($$LABEL("QUANTITY OF PREVIOUS FILL")),"",QPF)
+37 ;
+38 DO SET("DATABASE INDICATOR",80-$LENGTH($$LABEL("DATABASE INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DATABASE INDICATOR"))
+39 DO SET("OTHER PRESCRIBER INDICATOR",80-$LENGTH($$LABEL("OTHER PRESCRIBER INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PRESCRIBER INDICATOR"))
+40 DO SET("DUR FREE TEXT MESSAGE",80-$LENGTH($$LABEL("DUR FREE TEXT MESSAGE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR FREE TEXT MESSAGE"))
+41 DO SET("DUR ADDITIONAL TEXT",80-$LENGTH($$LABEL("DUR ADDITIONAL TEXT")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR ADDITIONAL TEXT"))
End DoDot:1
+42 SET VALMCNT=LINE
+43 QUIT
+44 ;
LABEL(FIELD) ; Sets the label for the field
+1 IF FIELD="MESSAGE"
QUIT "Payer Msg: "
+2 IF FIELD="PAYER ADDL MSG"
QUIT "Payer Addl Msg: "
+3 IF FIELD="DUR PPS RESPONSE"
QUIT "DUR Response: "
+4 IF FIELD="REASON FOR SERVICE CODE"
QUIT "Reason Code: "
+5 IF FIELD="CLINICAL SIGNIFICANCE CODE"
QUIT "Clinical Significance Code: "
+6 IF FIELD="OTHER PHARMACY INDICATOR"
QUIT "Other Pharmacy Indicator: "
+7 IF FIELD="PREVIOUS DATE OF FILL"
QUIT "Previous Date of Fill: "
+8 IF FIELD="QUANTITY OF PREVIOUS FILL"
QUIT "Quantity of Previous Fill: "
+9 IF FIELD="DATABASE INDICATOR"
QUIT "Database Indicator: "
+10 IF FIELD="OTHER PRESCRIBER INDICATOR"
QUIT "Other Prescriber Indicator: "
+11 IF FIELD="DUR FREE TEXT MESSAGE"
QUIT "DUR Text: "
+12 IF FIELD="DUR ADDITIONAL TEXT"
QUIT "DUR Add Text: "
+13 IF FIELD="INVALID PROVIDER DATA SOURCE"
QUIT "Invalid Provider Data Source: "
+14 IF FIELD="FORMULARY ALTERNATIVE EFF DATE"
QUIT "Formulary Alternative Eff Date: "
+15 IF FIELD="DUR/DUE CO-AGENT DESCRIPTION"
QUIT "DUR/DUE Co-Agent Description: "
+16 IF FIELD="UNIT OF PRIOR DISPENSED QTY"
QUIT "Unit of Prior Dispensed Quantity: "
+17 IF FIELD="OTHER PHARMACY ID QUALIFIER"
QUIT "Other Pharmacy ID Qualifier: "
+18 IF FIELD="OTHER PHARMACY NAME"
QUIT "Other Pharmacy Name: "
+19 IF FIELD="OTHER PHARMACY TELEPHONE"
QUIT "Other Pharmacy Telephone: "
+20 IF FIELD="OTHER PRESCRIBER LAST NAME"
QUIT "Other Prescriber Last Name: "
+21 IF FIELD="OTHER PRESCRIBER ID QUALIFIER"
QUIT "Other Prescriber ID Qualifier: "
+22 IF FIELD="OTHER PRESCRIBER ID"
QUIT "Other Prescriber ID: "
+23 IF FIELD="OTHER PRESCRIBER PHONE NUMBER"
QUIT "Other Prescriber Phone Number: "
+24 IF FIELD="DUR/DUE COMPOUND PRODUCT ID"
QUIT "DUR/DUE Compound Product ID: "
+25 IF FIELD="DUR/DUE CMPND PRDUCT ID QUALIF"
QUIT "DUR/DUE Compound Product ID Qualifier: "
+26 IF FIELD="DUR/DUE MAXIMUM DAILY DOSE QTY"
QUIT "DUR/DUE Maximum Daily Dose Quantity: "
+27 IF FIELD="DUR/DUE MAX DAILY DOSE - UNIT"
QUIT "DUR/DUE Maximum Daily Dose Unit: "
+28 IF FIELD="DUR/DUE MINIMUM DAILY DOSE QTY"
QUIT "DUR/DUE Minimum Daily Dose Quantity: "
+29 IF FIELD="DUR/DUE MIN DAILY DOSE - UNIT"
QUIT "DUR/DUE Minimum Daily Dose Unit: "
+30 QUIT ""
+31 ;
SET(FIELD,L,UND,TXT) ; Sets the lines for fields that require text wrapping
+1 NEW I,T
+2 IF $LENGTH(TXT)'>L
DO SETLN($$LABEL(FIELD)_TXT,,$SELECT($GET(UND):1,1:0),80-L)
QUIT
+3 FOR I=1:1
if TXT=""
QUIT
Begin DoDot:1
+4 IF I=1
DO SETLN($$LABEL(FIELD)_$EXTRACT(TXT,1,L),,,80-L)
SET TXT=$EXTRACT(TXT,L+1,999)
QUIT
+5 SET T=""
SET $EXTRACT(T,81-L)=$EXTRACT(TXT,1,L)
DO SETLN(T,,$SELECT($EXTRACT(TXT,L+1,999)=""&$GET(UND):1,1:0),80-L)
SET TXT=$EXTRACT(TXT,L+1,999)
End DoDot:1
+6 QUIT
+7 ;
SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section
+1 NEW X
+2 if $GET(TEXT)=""
SET $EXTRACT(TEXT,80)=""
+3 if $LENGTH(TEXT)>80
SET TEXT=$EXTRACT(TEXT,1,80)
+4 SET LINE=LINE+1
SET ^TMP("PSOREJP2",$JOB,LINE,0)=$GET(TEXT)
+5 ;
+6 IF LINE>$GET(LASTLN)
DO SAVE^VALM10(LINE)
SET LASTLN=LINE
+7 ;
+8 IF $GET(REV)
Begin DoDot:1
+9 DO CNTRL^VALM10(LINE,1,$LENGTH(TEXT),IORVON,IOINORM)
+10 IF $GET(UND)
DO CNTRL^VALM10(LINE,$LENGTH(TEXT)+1,80,IOUON,IOINORM)
End DoDot:1
QUIT
+11 IF $GET(UND)
DO CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
+12 IF $GET(HIG)
Begin DoDot:1
+13 DO CNTRL^VALM10(LINE,HIG,80,IOINHI_$SELECT($GET(UND):IOUON,1:""),IOINORM)
End DoDot:1
+14 QUIT
+15 ;
RXCOB(RX,REJ) ; Return the COB Indicator for the reject
+1 ; Input: RX = RX IEN
+2 ; REJ = Reject Info multiple IEN
+3 IF '$GET(RX)
QUIT ""
+4 IF '$GET(REJ)
QUIT ""
+5 NEW RXCOB
+6 SET RXCOB=$$GET1^DIQ(52.25,REJ_","_RX_",","27","I")
+7 QUIT $SELECT(+RXCOB>1:RXCOB,1:1)
+8 ;
RESPIEN(RX,REJ) ; Return the RESPONSE ID from the Reject Info multiple
+1 ; Input: RX = RX IEN
+2 ; REJ = Reject Info multiple IEN
+3 IF '$GET(RX)
QUIT ""
+4 IF '$GET(REJ)
QUIT ""
+5 QUIT $$GET1^DIQ(52.25,REJ_","_RX_",","16","I")
+6 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
REJ ; - DUR Information - called from REJ^PSOREJP1
+1 ; this code moved from PSOREJP1, routine was too large
+2 ;
+3 ; IA 4719
SET PSONAF=$$NFLDT^BPSBUTL(RX,FILL)
+4 ; PSO*7*421
IF PSONAF'=""
DO SETLN^PSOREJP1("Next Avail Fill: "_$$FMTE^XLFDT(PSONAF),,,16)
+5 ; IA 4719
SET PSOADD=$$ADDFLDS^BPSBUTL(RX,FILL,PSOCOB)
+6 IF $PIECE(PSOADD,U)'=""
DO SETLN^PSOREJP1("Maximum Age Qualifier: "_$PIECE(PSOADD,U),,,22)
+7 IF $PIECE(PSOADD,U,2)'=""
DO SETLN^PSOREJP1("Maximum Age: "_$PIECE(PSOADD,U,2),,,12)
+8 IF $PIECE(PSOADD,U,3)'=""
DO SETLN^PSOREJP1("Maximum Amount: "_$PIECE(PSOADD,U,3),,,15)
+9 IF $PIECE(PSOADD,U,4)'=""
DO SETLN^PSOREJP1("Maximum Amount Qualifier: "_$PIECE(PSOADD,U,4),,,25)
+10 IF $PIECE(PSOADD,U,5)'=""
DO SETLN^PSOREJP1("Maximum Amount Time Period: "_$PIECE(PSOADD,U,5),,,27)
+11 IF $PIECE(PSOADD,U,6)'=""
DO SETLN^PSOREJP1("Maximum Amount Time Period Start Date: "_$$FMTE^XLFDT($PIECE(PSOADD,U,6)),,,38)
+12 IF $PIECE(PSOADD,U,7)'=""
DO SETLN^PSOREJP1("Maximum Amount Time Period End Date: "_$$FMTE^XLFDT($PIECE(PSOADD,U,7)),,,36)
+13 IF $PIECE(PSOADD,U,8)'=""
DO SETLN^PSOREJP1("Maximum Amount Time Period Units: "_$PIECE(PSOADD,U,8),,,33)
+14 IF $PIECE(PSOADD,U,9)'=""
DO SETLN^PSOREJP1("Minimum Age Qualifier: "_$PIECE(PSOADD,U,9),,,22)
+15 IF $PIECE(PSOADD,U,10)'=""
DO SETLN^PSOREJP1("Minimum Age: "_$PIECE(PSOADD,U,10),,,12)
+16 IF $PIECE(PSOADD,U,11)'=""
DO SETLN^PSOREJP1("Minimum Amount: "_$PIECE(PSOADD,U,11),,,15)
+17 IF $PIECE(PSOADD,U,12)'=""
DO SETLN^PSOREJP1("Minimum Amount Qualifier: "_$PIECE(PSOADD,U,12),,,25)
+18 IF $PIECE(PSOADD,U,13)'=""
DO SETLN^PSOREJP1("Remaining Amount: "_$PIECE(PSOADD,U,13),,,17)
+19 IF $PIECE(PSOADD,U,14)'=""
DO SETLN^PSOREJP1("Remaining Amount Qualifier: "_$PIECE(PSOADD,U,14),,,27)
+20 ;
+21 DO SET^PSOREJP1("PAYER MESSAGE",63)
+22 DO SET^PSOREJP1("REASON",63)
+23 SET PFLDT=$$FMTE^XLFDT($GET(DATA(REJ,"PLAN PREVIOUS FILL DATE")))
+24 DO SET^PSOREJP1("DUR TEXT",63,$SELECT(PFLDT="":1,1:0))
+25 IF PFLDT'=""
DO SETLN^PSOREJP1("Last Fill Date : "_PFLDT_" (from payer)",,1,18)
+26 QUIT
+27 ;
PSOETEC(RX,FILL) ; Returns flag for TRICARE or CHAMPVA non-billable claims
+1 ;This function is used to determine how a claim is stored in the PSO AUDIT LOG (file #56.87),
+2 ;it is not necessary to check to see if the claim has a reject that is resolved or unresolved
+3 ; Returns: 1 - if rejection code is eT or eC (pseudo-reject code) / 0 - otherwise
+4 NEW PSOQ,PSRXIEN
+5 IF '$GET(RX)
QUIT 0
+6 IF $DATA(^PSRX(RX,"REJ","B","eT"))
Begin DoDot:1
+7 SET PSRXIEN=0
+8 SET PSOQ=1
+9 FOR
SET PSRXIEN=$ORDER(^PSRX(RX,"REJ","B","eT",PSRXIEN))
if 'PSRXIEN
QUIT
Begin DoDot:2
+10 IF $$GET1^DIQ(52.25,PSRXIEN_","_RX,2)["NOT INSURED"
SET PSOQ=0
End DoDot:2
End DoDot:1
QUIT PSOQ
+11 IF $DATA(^PSRX(RX,"REJ","B","eC"))
Begin DoDot:1
+12 SET PSRXIEN=0
+13 SET PSOQ=1
+14 FOR
SET PSRXIEN=$ORDER(^PSRX(RX,"REJ","B","eC",PSRXIEN))
if 'PSRXIEN
QUIT
Begin DoDot:2
+15 IF $$GET1^DIQ(52.25,PSRXIEN_","_RX,2)["NOT INSURED"
SET PSOQ=0
End DoDot:2
End DoDot:1
QUIT PSOQ
+16 QUIT 0
+17 ;
