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

PSOREJP5.m

Go to the documentation of this file.
PSOREJP5 ;ALB/BNT - Third Party Reject Additional Reject Information Screen ;02/14/11
 ;;7.0;OUTPATIENT PHARMACY;**359,421,512,528,560**;DEC 1997;Build 22
 ;
 ; 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
 I '$G(RX) Q 0
 I $D(^PSRX(RX,"REJ","B","eT")) Q 1
 I $D(^PSRX(RX,"REJ","B","eC")) Q 1
 Q 0
 ;