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.
  1. 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
  1. ;
  1. ; Reference to $$NFLDT^BPSBUTL in ICR 4719
  1. ; Reference to DURRESP^BPSNCPD3 in ICR 4560
  1. ;
  1. EN ; -- main entry point for PSO REJECT DISPLAY ADDTNL INFO
  1. D EN^VALM("PSO REJECT DISPLAY ADDTNL INFO")
  1. Q
  1. ;
  1. ADDTXT ; Entry point for DUR Hidden action
  1. I '$D(@(VALMAR)) Q
  1. N FILL,LASTLN
  1. S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5)
  1. D FULL^VALM1
  1. D EN
  1. Q
  1. ;
  1. ISDUR(RX,REJ) ;
  1. ; Returns 1 if there is DUR PPS RESPONSE data for the reject
  1. I '$G(RX) Q 0
  1. I '$G(REJ) Q 0
  1. N RXCOB,DURPPS,DURIEN
  1. S DURIEN=$$RESPIEN(RX,REJ)
  1. Q:DURIEN="" 0
  1. S RXCOB=$$RXCOB(RX,REJ)
  1. I RXCOB="" S RXCOB=1
  1. D DURRESP^BPSNCPD3(DURIEN,.DURPPS,RXCOB)
  1. I $G(DURPPS(RXCOB,"DUR PPS RESPONSE"))!($G(DURPPS(RXCOB,"MESSAGE"))]"")!($G(DURPPS(RXCOB,"PAYER MESSAGE",1))]"") Q 1
  1. Q 0
  1. ;
  1. HDR ; -- header code
  1. N LINE1,LINE2,PTINFO,X
  1. S VALMHDR(1)=$$DVINFO^PSOREJU2(RX,FILL,1)
  1. S PTINFO=$$PTINFO^PSOREJU2(RX,1)
  1. S VALMHDR(2)=$P(PTINFO,U,1)
  1. S VALMHDR(3)=$P(PTINFO,U,2)
  1. S VALMHDR(4)=$$RXINFO^PSOREJP3(RX,FILL,1)
  1. S VALMHDR(5)=$$RXINFO^PSOREJP3(RX,FILL,2,REJ)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. N ADDREJ,DATA,DURIEN,I,LINE,NDX,RXCOB,X
  1. F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
  1. K ^TMP("PSOREJP2",$J) S VALMCNT=0,LINE=0
  1. S DURIEN=$$RESPIEN(RX,REJ)
  1. Q:DURIEN=""
  1. S RXCOB=$$RXCOB(RX,REJ)
  1. D DURRESP^BPSNCPD3(DURIEN,.ADDREJ,RXCOB)
  1. I '+$G(ADDREJ(RXCOB,"DUR PPS RESPONSE")),$G(ADDREJ(RXCOB,"MESSAGE"))']"",$G(ADDREJ(RXCOB,"PAYER MESSAGE",1))="" D Q
  1. . D SETLN()
  1. . D SETLN("There is no additional reject information to display")
  1. ;
  1. D SETLN()
  1. D SET("MESSAGE",80-$L($$LABEL("MESSAGE")),"",ADDREJ(RXCOB,"MESSAGE"))
  1. ;
  1. D SETLN()
  1. D SET("PAYER ADDL MSG",80-$L($$LABEL("PAYER ADDL MSG")),"",$G(ADDREJ(RXCOB,"PAYER MESSAGE",1)))
  1. S X="",$E(X,$L($$LABEL("PAYER ADDL MSG")))=" "
  1. S I=1 F S I=$O(ADDREJ(RXCOB,"PAYER MESSAGE",I)) Q:'I D
  1. . D SET("",80-$L($$LABEL("PAYER ADDL MSG")),"",X_ADDREJ(RXCOB,"PAYER MESSAGE",I))
  1. ;
  1. D BPSRESP^PSOREJP6(DURIEN)
  1. ;
  1. S NDX=""
  1. F S NDX=$O(ADDREJ(RXCOB,"DUR PPS",NDX)) Q:NDX="" D
  1. . N QPF
  1. . D SETLN()
  1. . D SET("DUR PPS RESPONSE",80-$L($$LABEL("DUR PPS RESPONSE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR PPS RESPONSE"))
  1. . D SET("REASON FOR SERVICE CODE",80-$L($$LABEL("REASON FOR SERVICE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"REASON FOR SERVICE CODE"))
  1. . D SET("CLINICAL SIGNIFICANCE CODE",80-$L($$LABEL("CLINICAL SIGNIFICANCE CODE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"CLINICAL SIGNIFICANCE CODE"))
  1. . D SET("OTHER PHARMACY INDICATOR",80-$L($$LABEL("OTHER PHARMACY INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PHARMACY INDICATOR"))
  1. . D SET("PREVIOUS DATE OF FILL",80-$L($$LABEL("PREVIOUS DATE OF FILL")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"PREVIOUS DATE OF FILL"))
  1. . ;
  1. . ; esg - PSO*7*421 - 2/4/13 - properly display Quantity of Previous Fill
  1. . S QPF=""
  1. . I ADDREJ(RXCOB,"DUR PPS",NDX,"QUANTITY OF PREVIOUS FILL") S QPF=ADDREJ(RXCOB,"DUR PPS",NDX,"QUANTITY OF PREVIOUS FILL")/1000
  1. . D SET("QUANTITY OF PREVIOUS FILL",80-$L($$LABEL("QUANTITY OF PREVIOUS FILL")),"",QPF)
  1. . ;
  1. . D SET("DATABASE INDICATOR",80-$L($$LABEL("DATABASE INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DATABASE INDICATOR"))
  1. . D SET("OTHER PRESCRIBER INDICATOR",80-$L($$LABEL("OTHER PRESCRIBER INDICATOR")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"OTHER PRESCRIBER INDICATOR"))
  1. . D SET("DUR FREE TEXT MESSAGE",80-$L($$LABEL("DUR FREE TEXT MESSAGE")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR FREE TEXT MESSAGE"))
  1. . D SET("DUR ADDITIONAL TEXT",80-$L($$LABEL("DUR ADDITIONAL TEXT")),"",ADDREJ(RXCOB,"DUR PPS",NDX,"DUR ADDITIONAL TEXT"))
  1. S VALMCNT=LINE
  1. Q
  1. ;
  1. LABEL(FIELD) ; Sets the label for the field
  1. I FIELD="MESSAGE" Q "Payer Msg: "
  1. I FIELD="PAYER ADDL MSG" Q "Payer Addl Msg: "
  1. I FIELD="DUR PPS RESPONSE" Q "DUR Response: "
  1. I FIELD="REASON FOR SERVICE CODE" Q "Reason Code: "
  1. I FIELD="CLINICAL SIGNIFICANCE CODE" Q "Clinical Significance Code: "
  1. I FIELD="OTHER PHARMACY INDICATOR" Q "Other Pharmacy Indicator: "
  1. I FIELD="PREVIOUS DATE OF FILL" Q "Previous Date of Fill: "
  1. I FIELD="QUANTITY OF PREVIOUS FILL" Q "Quantity of Previous Fill: "
  1. I FIELD="DATABASE INDICATOR" Q "Database Indicator: "
  1. I FIELD="OTHER PRESCRIBER INDICATOR" Q "Other Prescriber Indicator: "
  1. I FIELD="DUR FREE TEXT MESSAGE" Q "DUR Text: "
  1. I FIELD="DUR ADDITIONAL TEXT" Q "DUR Add Text: "
  1. I FIELD="INVALID PROVIDER DATA SOURCE" Q "Invalid Provider Data Source: "
  1. I FIELD="FORMULARY ALTERNATIVE EFF DATE" Q "Formulary Alternative Eff Date: "
  1. I FIELD="DUR/DUE CO-AGENT DESCRIPTION" Q "DUR/DUE Co-Agent Description: "
  1. I FIELD="UNIT OF PRIOR DISPENSED QTY" Q "Unit of Prior Dispensed Quantity: "
  1. I FIELD="OTHER PHARMACY ID QUALIFIER" Q "Other Pharmacy ID Qualifier: "
  1. I FIELD="OTHER PHARMACY NAME" Q "Other Pharmacy Name: "
  1. I FIELD="OTHER PHARMACY TELEPHONE" Q "Other Pharmacy Telephone: "
  1. I FIELD="OTHER PRESCRIBER LAST NAME" Q "Other Prescriber Last Name: "
  1. I FIELD="OTHER PRESCRIBER ID QUALIFIER" Q "Other Prescriber ID Qualifier: "
  1. I FIELD="OTHER PRESCRIBER ID" Q "Other Prescriber ID: "
  1. I FIELD="OTHER PRESCRIBER PHONE NUMBER" Q "Other Prescriber Phone Number: "
  1. I FIELD="DUR/DUE COMPOUND PRODUCT ID" Q "DUR/DUE Compound Product ID: "
  1. I FIELD="DUR/DUE CMPND PRDUCT ID QUALIF" Q "DUR/DUE Compound Product ID Qualifier: "
  1. I FIELD="DUR/DUE MAXIMUM DAILY DOSE QTY" Q "DUR/DUE Maximum Daily Dose Quantity: "
  1. I FIELD="DUR/DUE MAX DAILY DOSE - UNIT" Q "DUR/DUE Maximum Daily Dose Unit: "
  1. I FIELD="DUR/DUE MINIMUM DAILY DOSE QTY" Q "DUR/DUE Minimum Daily Dose Quantity: "
  1. I FIELD="DUR/DUE MIN DAILY DOSE - UNIT" Q "DUR/DUE Minimum Daily Dose Unit: "
  1. Q ""
  1. ;
  1. SET(FIELD,L,UND,TXT) ; Sets the lines for fields that require text wrapping
  1. N I,T
  1. I $L(TXT)'>L D SETLN($$LABEL(FIELD)_TXT,,$S($G(UND):1,1:0),80-L) Q
  1. F I=1:1 Q:TXT="" D
  1. . I I=1 D SETLN($$LABEL(FIELD)_$E(TXT,1,L),,,80-L) S TXT=$E(TXT,L+1,999) Q
  1. . 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)
  1. Q
  1. ;
  1. SETLN(TEXT,REV,UND,HIG) ; Sets a line to be displayed in the Body section
  1. N X
  1. S:$G(TEXT)="" $E(TEXT,80)=""
  1. S:$L(TEXT)>80 TEXT=$E(TEXT,1,80)
  1. S LINE=LINE+1,^TMP("PSOREJP2",$J,LINE,0)=$G(TEXT)
  1. ;
  1. I LINE>$G(LASTLN) D SAVE^VALM10(LINE) S LASTLN=LINE
  1. ;
  1. I $G(REV) D Q
  1. . D CNTRL^VALM10(LINE,1,$L(TEXT),IORVON,IOINORM)
  1. . I $G(UND) D CNTRL^VALM10(LINE,$L(TEXT)+1,80,IOUON,IOINORM)
  1. I $G(UND) D CNTRL^VALM10(LINE,1,80,IOUON,IOINORM)
  1. I $G(HIG) D
  1. . D CNTRL^VALM10(LINE,HIG,80,IOINHI_$S($G(UND):IOUON,1:""),IOINORM)
  1. Q
  1. ;
  1. RXCOB(RX,REJ) ; Return the COB Indicator for the reject
  1. ; Input: RX = RX IEN
  1. ; REJ = Reject Info multiple IEN
  1. I '$G(RX) Q ""
  1. I '$G(REJ) Q ""
  1. N RXCOB
  1. S RXCOB=$$GET1^DIQ(52.25,REJ_","_RX_",","27","I")
  1. Q $S(+RXCOB>1:RXCOB,1:1)
  1. ;
  1. RESPIEN(RX,REJ) ; Return the RESPONSE ID from the Reject Info multiple
  1. ; Input: RX = RX IEN
  1. ; REJ = Reject Info multiple IEN
  1. I '$G(RX) Q ""
  1. I '$G(REJ) Q ""
  1. Q $$GET1^DIQ(52.25,REJ_","_RX_",","16","I")
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. REJ ; - DUR Information - called from REJ^PSOREJP1
  1. ; this code moved from PSOREJP1, routine was too large
  1. ;
  1. S PSONAF=$$NFLDT^BPSBUTL(RX,FILL) ; IA 4719
  1. I PSONAF'="" D SETLN^PSOREJP1("Next Avail Fill: "_$$FMTE^XLFDT(PSONAF),,,16) ; PSO*7*421
  1. S PSOADD=$$ADDFLDS^BPSBUTL(RX,FILL,PSOCOB) ; IA 4719
  1. I $P(PSOADD,U)'="" D SETLN^PSOREJP1("Maximum Age Qualifier: "_$P(PSOADD,U),,,22)
  1. I $P(PSOADD,U,2)'="" D SETLN^PSOREJP1("Maximum Age: "_$P(PSOADD,U,2),,,12)
  1. I $P(PSOADD,U,3)'="" D SETLN^PSOREJP1("Maximum Amount: "_$P(PSOADD,U,3),,,15)
  1. I $P(PSOADD,U,4)'="" D SETLN^PSOREJP1("Maximum Amount Qualifier: "_$P(PSOADD,U,4),,,25)
  1. I $P(PSOADD,U,5)'="" D SETLN^PSOREJP1("Maximum Amount Time Period: "_$P(PSOADD,U,5),,,27)
  1. I $P(PSOADD,U,6)'="" D SETLN^PSOREJP1("Maximum Amount Time Period Start Date: "_$$FMTE^XLFDT($P(PSOADD,U,6)),,,38)
  1. I $P(PSOADD,U,7)'="" D SETLN^PSOREJP1("Maximum Amount Time Period End Date: "_$$FMTE^XLFDT($P(PSOADD,U,7)),,,36)
  1. I $P(PSOADD,U,8)'="" D SETLN^PSOREJP1("Maximum Amount Time Period Units: "_$P(PSOADD,U,8),,,33)
  1. I $P(PSOADD,U,9)'="" D SETLN^PSOREJP1("Minimum Age Qualifier: "_$P(PSOADD,U,9),,,22)
  1. I $P(PSOADD,U,10)'="" D SETLN^PSOREJP1("Minimum Age: "_$P(PSOADD,U,10),,,12)
  1. I $P(PSOADD,U,11)'="" D SETLN^PSOREJP1("Minimum Amount: "_$P(PSOADD,U,11),,,15)
  1. I $P(PSOADD,U,12)'="" D SETLN^PSOREJP1("Minimum Amount Qualifier: "_$P(PSOADD,U,12),,,25)
  1. I $P(PSOADD,U,13)'="" D SETLN^PSOREJP1("Remaining Amount: "_$P(PSOADD,U,13),,,17)
  1. I $P(PSOADD,U,14)'="" D SETLN^PSOREJP1("Remaining Amount Qualifier: "_$P(PSOADD,U,14),,,27)
  1. ;
  1. D SET^PSOREJP1("PAYER MESSAGE",63)
  1. D SET^PSOREJP1("REASON",63)
  1. S PFLDT=$$FMTE^XLFDT($G(DATA(REJ,"PLAN PREVIOUS FILL DATE")))
  1. D SET^PSOREJP1("DUR TEXT",63,$S(PFLDT="":1,1:0))
  1. I PFLDT'="" D SETLN^PSOREJP1("Last Fill Date : "_PFLDT_" (from payer)",,1,18)
  1. Q
  1. ;
  1. 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),
  1. ;it is not necessary to check to see if the claim has a reject that is resolved or unresolved
  1. ; Returns: 1 - if rejection code is eT or eC (pseudo-reject code) / 0 - otherwise
  1. N PSOQ,PSRXIEN
  1. I '$G(RX) Q 0
  1. I $D(^PSRX(RX,"REJ","B","eT")) D Q PSOQ
  1. . S PSRXIEN=0
  1. . S PSOQ=1
  1. . F S PSRXIEN=$O(^PSRX(RX,"REJ","B","eT",PSRXIEN)) Q:'PSRXIEN D
  1. . . I $$GET1^DIQ(52.25,PSRXIEN_","_RX,2)["NOT INSURED" S PSOQ=0
  1. I $D(^PSRX(RX,"REJ","B","eC")) D Q PSOQ
  1. . S PSRXIEN=0
  1. . S PSOQ=1
  1. . F S PSRXIEN=$O(^PSRX(RX,"REJ","B","eC",PSRXIEN)) Q:'PSRXIEN D
  1. . . I $$GET1^DIQ(52.25,PSRXIEN_","_RX,2)["NOT INSURED" S PSOQ=0
  1. Q 0
  1. ;