- PSOREJP5 ;ALB/BNT - Third Party Reject Additional Reject Information Screen ;02/14/11
- ;;7.0;OUTPATIENT PHARMACY;**359,421,512,528,560,561,704**;DEC 1997;Build 16
- ;
- ; Reference to $$NFLDT^BPSBUTL in ICR 4719
- ; Reference to DURRESP^BPSNCPD3 in ICR 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,PTINFO,X
- S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1)
- S PTINFO=$$PTINFO^PSOREJU2(RX,1)
- S VALMHDR(2)=$P(PTINFO,U,1)
- S VALMHDR(3)=$P(PTINFO,U,2)
- S VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,1)
- S VALMHDR(5)=$$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 9935 printed Feb 19, 2025@00:00:01 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,704**;DEC 1997;Build 16
- +2 ;
- +3 ; Reference to $$NFLDT^BPSBUTL in ICR 4719
- +4 ; Reference to DURRESP^BPSNCPD3 in ICR 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,PTINFO,X
- +2 SET VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1)
- +3 SET PTINFO=$$PTINFO^PSOREJU2(RX,1)
- +4 SET VALMHDR(2)=$PIECE(PTINFO,U,1)
- +5 SET VALMHDR(3)=$PIECE(PTINFO,U,2)
- +6 SET VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,1)
- +7 SET VALMHDR(5)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ)
- +8 QUIT
- +9 ;
- 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 ;