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

PSOREJP0.m

Go to the documentation of this file. 
  1. PSOREJP0 ;BIRM/MFR - Third Party Rejects Processing Screen ;04/28/05
  1.  ;;7.0;OUTPATIENT PHARMACY;**148,260,287,289**;DEC 1997;Build 107
  1.  ;
  1.  N PSOREJST,PSORJSRT,PSORJASC,PSOSTFLT,PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT,PSOINGRP,PSOTRITG
  1.  N INSLN,HIGHLN,LASTLN,PSOEKEY
  1.  ;
  1.  ; - Division/Site selection
  1.  D SEL^PSOREJU1("DIVISION","^PS(59,",.PSOREJST,$$GET1^DIQ(59,+$G(PSOSITE),.01)) I $G(PSOREJST)="^" G EXIT
  1.  ;
  1.  ; - Initializing global variables
  1.  S PSORJSRT="PA",PSORJASC=1,PSOSTFLT="U",(PSODRFLT,PSOPTFLT,PSORXFLT,PSOINFLT)="ALL"
  1.  S PSOINGRP=0,PSOTRITG=1
  1.  ;
  1.  D LST("W")
  1.  G EXIT
  1.  ;
  1. LST(PSOMENU) ; - Invokes Listmanager
  1.  W !,"Please wait..."
  1.  I PSOMENU="W" D EN^VALM("PSO REJECTS WORKLIST")
  1.  I PSOMENU="VP" D EN^VALM("PSO REJECTS VIEW/PROCESS")
  1.  D FULL^VALM1
  1.  Q
  1.  ;
  1. HDR      ; - Header code
  1.  N LINE1,LINE2,LINE3
  1.  S LINE1=$$SITES() I $L(LINE1)>80 S $E(LINE1,78,999)="..."
  1.  ;
  1.  S LINE2="Selection : ALL "_$S(PSOSTFLT="U":"UNRESOLVED ",PSOSTFLT="R":"RESOLVED ",1:"")_"REJECTS"
  1.  I $G(PSOPTFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("P")
  1.  I $G(PSODRFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("D")
  1.  I $G(PSOINFLT)'="ALL" S LINE2=LINE2_" FOR "_$$NAME("I")
  1.  I $G(PSOINGRP) S LINE2=LINE2_" GROUPED BY INSURANCE"
  1.  S VALMHDR(1)=LINE1,VALMHDR(2)=LINE2
  1.  I PSOMENU="VP" D
  1.  . I $G(PSORXFLT) S LINE3="Rx#       : "_$$NAME("R")
  1.  . E  D
  1.  . . S LINE3="Date Range: "_$$FMTE^XLFDT(+PSODTRNG,2)
  1.  . . I +PSODTRNG'=$P(PSODTRNG,"^",2) S LINE3=LINE3_" THRU "_$$FMTE^XLFDT($P(PSODTRNG,"^",2),2)
  1.  . S VALMHDR(3)=LINE3
  1.  ;
  1.  D SETHDR()
  1.  Q
  1.  ;
  1. SETHDR() ; - Displays the Header Line
  1.  N HDR,ORD
  1.  ;
  1.  S HDR="  #",$E(HDR,5)="Rx#",$E(HDR,18)="PATIENT(ID)",$E(HDR,43)="DRUG",$E(HDR,64)="REASON"
  1.  S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,$S(PSOMENU="W":4,1:5))
  1.  S ORD=$S(PSORJASC=1:"[^]",1:"[v]")
  1.  S:PSORJSRT="RX" POS=9 S:PSORJSRT="PA" POS=30 S:PSORJSRT="DR" POS=48 S:PSORJSRT="RE" POS=71
  1.  D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,$S(PSOMENU="W":4,1:5))
  1.  Q
  1.  ;
  1. INIT ; - Populates the Body section for ListMan
  1.  K ^TMP("PSOREJP0",$J)
  1.  D SETSORT(PSORJSRT),SETLINE
  1.  S VALMSG="Select the entry # to view or ?? for more actions"
  1.  Q
  1.  ;
  1. SETLINE ; - Sets the line to be displayed in ListMan
  1.  N INS,SUB,SEQ,SORTA,LINE,Z,I,X,X1,X2
  1.  I '$D(^TMP("PSOREJSR",$J)) D  Q
  1.  . F I=1:1:7 S ^TMP("PSOREJP0",$J,I,0)=""
  1.  . S ^TMP("PSOREJP0",$J,8,0)="               No Clinical Third Party Payer Rejects found."
  1.  . S VALMCNT=1
  1.  ;
  1.  F I=1:1:$G(LASTLN) D RESTORE^VALM10(I)
  1.  K INSLN,HIGHLN
  1.  ;
  1.  S (SORTA,INS,SUB)="",LINE=0 K ^TMP("PSOREJP0",$J)
  1.  F  S SORTA=$O(^TMP("PSOREJSR",$J,SORTA)) Q:SORTA=""  D
  1.  . F  S INS=$O(^TMP("PSOREJSR",$J,SORTA,INS)) Q:INS=""  D
  1.  .. I INS'="<NULL>" D
  1.  ... D GROUP(INS,.LINE)
  1.  .. F  S SUB=$O(^TMP("PSOREJSR",$J,SORTA,INS,SUB),PSORJASC) Q:SUB=""  D
  1.  ... S Z=$G(^TMP("PSOREJSR",$J,SORTA,INS,SUB))
  1.  ... S X1="",SEQ=$G(SEQ)+1,X1=$J(SEQ,3)
  1.  ... S $E(X1,5)=$P(Z,"^",3),$E(X1,18)=$P(Z,"^",4),$E(X1,43)=$P(Z,"^",5),$E(X1,64)=$P(Z,"^",6)
  1.  ... S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X1,HIGHLN(LINE)=""
  1.  ... S X2="",$E(X2,5)="Payer Message: "_$P(Z,"^",7)
  1.  ... S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X2
  1.  ... S ^TMP("PSOREJP0",$J,SEQ,"RX")=$P(Z,"^",1,2)
  1.  ;
  1.  I LINE>$G(LASTLN) D
  1.  . F I=($G(LASTLN)+1):1:LINE D SAVE^VALM10(I)
  1.  . S LASTLN=LINE
  1.  ;
  1.  ; - Highlighting the prescription/insurance line
  1.  F LN=1:1:LINE D
  1.  . I $D(HIGHLN(LN)) D  Q
  1.  . . D CNTRL^VALM10(LN,1,80,IOINHI,IOINORM)
  1.  . . D CNTRL^VALM10(LN,64,3,IOUON,IOINORM)
  1.  . . D CNTRL^VALM10(LN,67,80,IOINHI,IOINORM)
  1.  . I $D(INSLN(LN)) D
  1.  . . S LBL=INSLN(LN),POS=41-($L(LBL)/2+.5\1)
  1.  . . D CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
  1.  . . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
  1.  . . D CNTRL^VALM10(LN,POS+$L(LBL),(81-POS-$L(LBL)),IOUON_IOINHI,IOINORM)
  1.  ;
  1.  S VALMCNT=+$G(LINE)
  1.  Q
  1.  ;
  1. GROUP(LBL,LINE) ; Sets an insurance delimiter line
  1.  N X,POS
  1.  S POS=41-($L(LBL)/2+.5\1)
  1.  S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
  1.  S LINE=LINE+1,^TMP("PSOREJP0",$J,LINE,0)=X,INSLN(LINE)=LBL
  1.  Q
  1.  ;
  1. SETSORT(FIELD) ; - Sets the data sorted by the FIELD specified
  1.  N RX,REJ,STS,DAT
  1.  K ^TMP("PSOREJSR",$J)
  1.  ;
  1.  ; - Worklist
  1.  I PSOMENU="W" D
  1.  . S RX=0 F  S RX=$O(^PSRX("REJSTS",0,RX)) Q:'RX  D
  1.  . . S REJ=0 F  S REJ=$O(^PSRX("REJSTS",0,RX,REJ)) Q:'REJ  D
  1.  . . . D SETTMP(RX,REJ,FIELD)
  1.  ;
  1.  ; - View/Process
  1.  I PSOMENU="VP" D
  1.  . I $G(PSORXFLT)'="ALL" D  Q
  1.  . . S REJ=0 F  S REJ=$O(^PSRX(+PSORXFLT,"REJ",REJ)) Q:'REJ  D
  1.  . . . I $$FLTSTS(+PSORXFLT,REJ) Q
  1.  . . . D SETTMP(+PSORXFLT,REJ,FIELD)
  1.  . S DAT=$P(PSODTRNG,"^")-0.0000001,(RX,REJ)=0
  1.  . F  S DAT=$O(^PSRX("REJDAT",DAT)) Q:'DAT!(DAT>$$ENDT())  D
  1.  . . F  S RX=$O(^PSRX("REJDAT",DAT,RX)) Q:'RX  D
  1.  . . . I $$FILTER(RX) Q
  1.  . . . F  S REJ=$O(^PSRX("REJDAT",DAT,RX,REJ)) Q:'REJ  D
  1.  . . . . I $$FLTSTS(RX,REJ) Q
  1.  . . . . D SETTMP(RX,REJ,FIELD)
  1.  Q
  1.  ;
  1. SETTMP(RX,REJ,FIELD) ; - Sets ^TMP global that will be displayed in the body section
  1.  N REJLST,FILL,CODE,RXNUM,PTNAME,DRNAME,MSG,REASON,MSG,X,Z,SORT,I,INS,OREJ,PSOTRIC,SORTA
  1.  I $G(PSORXFLT)="ALL",$$CLOSED^PSOREJP1(RX,REJ),$$REOPN^PSOREJP1(RX,REJ) Q
  1.  S FILL=+$$GET1^DIQ(52.25,REJ_","_RX,5),SORTA=1
  1.  I '$$DIV(RX,FILL) Q
  1.  K REJLST D GET^PSOREJU2(RX,FILL,.REJLST,,1) I '$D(REJLST) Q
  1.  I $$FILTER(,REJLST(REJ,"INSURANCE NAME")) Q
  1.  S CODE=$G(REJLST(REJ,"CODE"))
  1.  S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC)
  1.  Q:$G(PSOTRIC)&('$G(PSOTRITG))&(CODE'="79")&(CODE'="88")  ;show/hide non-DUR/RTS Tricare
  1.  S PTNAME=$$PTNAME(RX)
  1.  S DRNAME=$$GET1^DIQ(52,RX,6)
  1.  S RXNUM=$$GET1^DIQ(52,RX,.01)
  1.  S MSG=$G(REJLST(REJ,"PAYER MESSAGE")) I $L(MSG)>60 S MSG=$E(MSG,1,58)_"..."
  1.  S REASON=$S(CODE=88:"DUR:"_$G(REJLST(REJ,"REASON")),CODE=79:"79 :REFILL TOO SOON",1:CODE)
  1.  I CODE'=79&(CODE'=88) S REASON=CODE_" :"_$$EXP^PSOREJP1(CODE)
  1.  S Z="",$P(Z,"^")=RX,$P(Z,"^",2)=REJ,$P(Z,"^",3)=RXNUM,$P(Z,"^",4)=PTNAME
  1.  S $P(Z,"^",5)=$E(DRNAME,1,20),$P(Z,"^",6)=$E(REASON,1,17),$P(Z,"^",7)=MSG
  1.  S SORT=$S(FIELD="PA":PTNAME,FIELD="DR":DRNAME,FIELD="RX":RXNUM_" ",1:REASON)_RX_REJ
  1.  S INS="<NULL>"
  1.  I $G(PSOINGRP) S INS=REJLST(REJ,"INSURANCE NAME") S:INS="" INS="***UNKNOWN***"
  1.  S:$G(PSOTRIC)&(CODE'=79)&(CODE'=88) INS="TRICARE"_" - Non-DUR/RTS",SORTA=2
  1.  S:'$G(PSOTRIC)&(CODE'=79)&(CODE'=88) INS="OTHER REJECTS",SORTA=3
  1.  S ^TMP("PSOREJSR",$J,SORTA,INS,SORT)=Z
  1.  Q
  1.  ;
  1. PAT ; - Sort by Patient
  1.  D SORT("PA")
  1.  Q
  1. DRG ; - Sort by Drug
  1.  D SORT("DR")
  1.  Q
  1. RX ; - Sort by Rx
  1.  D SORT("RX")
  1.  Q
  1. REA ; - Sort by Reason
  1.  D SORT("RE")
  1.  Q
  1. SORT(FIELD) ; - Sort entries by FIELD
  1.  I PSORJSRT=FIELD S PSORJASC=$S(PSORJASC=1:-1,1:1)
  1.  E  S PSORJSRT=FIELD,PSORJASC=1
  1.  D REF
  1.  Q
  1.  ;
  1. REF ; - Screen Refresh
  1.  W ?52,"Please wait..." D INIT S VALMBCK="R"
  1.  Q
  1. GI ; - Group by Insurance
  1.  W ?52,"Please wait..." S PSOINGRP=$S($G(PSOINGRP):0,1:1) D INIT,HDR S VALMBCK="R"
  1.  Q
  1. TRICTOG ;  - Toggle Tricare display
  1.  W ?52,"Please wait..." S PSOTRITG=$S($G(PSOTRITG):0,1:1) D INIT,HDR S VALMBCK="R"
  1.  Q
  1.  ;
  1. SEL ; - Process selection of one entry
  1.  N PSOSEL,XQORM,Z,RX,REJ,PSOCHNG
  1.  S PSOSEL=+$P($P(Y(1),"^",4),"=",2) I 'PSOSEL S VALMSG="Invalid selection!",VALMBCK="R" Q
  1.  S Z=$G(^TMP("PSOREJP0",$J,PSOSEL,"RX"))
  1.  S RX=$P(Z,"^"),REJ=$P(Z,"^",2) I 'RX!'REJ S VALMSG="Invalid selection!",VALMBCK="R" Q
  1.  S PSOCHNG=0 D EN^PSOREJP1(RX,REJ,.PSOCHNG) I $G(PSOCHNG) D REF
  1.  Q
  1.  ;
  1. EXIT ;
  1.  K ^TMP("PSOREJP0",$J),^TMP("PSOREJSR",$J)
  1.  Q
  1.  ;
  1. HELP Q
  1.  ;
  1. SITES() ; - Returns the list of sites along with their NCPDP #s
  1.  N CNT,SITE,SITES,NAME
  1.  I '$D(PSOREJST) Q ""
  1.  I $G(PSOREJST)="ALL" Q "Divisions : ALL"
  1.  S SITE=0 F  S SITE=$O(PSOREJST(SITE)) Q:'SITE  D
  1.  . S NAME=$$GET1^DIQ(59,SITE,.01)
  1.  . S SITES=$G(SITES)_", "_NAME
  1.  S $E(SITES,1,2)="",SITES="Division"_$S($L(SITES,",")>1:"s",1:" ")_" : "_SITES
  1.  Q SITES
  1.  ;
  1. DIV(RX,FILL) ; - Check if the Division for the Prescription/Fill was selected by the user
  1.  ;
  1.  I $G(PSOREJST)="ALL" Q 1
  1.  I $D(PSOREJST($$RXSITE^PSOBPSUT(RX,FILL))) Q 1
  1.  Q 0
  1.  ;
  1. PTNAME(RX) ; - Returns header displayable - Patient Name (Last 4 SSN)
  1.  N DFN,VADM,PTNAME
  1.  S DFN=$$GET1^DIQ(52,RX,2,"I") D DEM^VADPT
  1.  S PTNAME=$E($G(VADM(1)),1,18)_"("_$P($P($G(VADM(2)),"^",2),"-",3)_")"
  1.  Q PTNAME
  1.  ;
  1. FILTER(RX,INS) ; - Filter entries based on user's selection
  1.  N FILTER,NAME
  1.  S FILTER=1
  1.  I $G(PSOPTFLT)'="ALL",$D(RX),'$D(PSOPTFLT($$GET1^DIQ(52,RX,2,"I"))) Q FILTER
  1.  I $G(PSODRFLT)'="ALL",$D(RX),'$D(PSODRFLT($$GET1^DIQ(52,RX,6,"I"))) Q FILTER
  1.  I $G(PSOINFLT)'="ALL",$D(INS) D  Q FILTER
  1.  . S NAME="" F  S NAME=$O(PSOINFLT(NAME)) Q:NAME=""  I $$UP^XLFSTR(INS)[$$UP^XLFSTR(NAME) S FILTER=0 Q
  1.  Q 0
  1.  ;
  1. FLTSTS(RX,REJ) ; - Filter for the Reject Status  
  1.  N STS
  1.  S STS=$$GET1^DIQ(52.25,REJ_","_RX,9,"I")
  1.  I PSOSTFLT="U",STS=1 Q 1
  1.  I PSOSTFLT="R",STS=0 Q 1
  1.  Q 0
  1.  ;
  1. NAME(TYPE) ; - Returns the name if ONE was selected or "MULTIPLE ..."
  1.  N I,CNT
  1.  ;
  1.  I TYPE="P",$O(PSOPTFLT($O(PSOPTFLT(""))))="" Q $$GET1^DIQ(2,$O(PSOPTFLT("")),.01)
  1.  I TYPE="D",$O(PSODRFLT($O(PSODRFLT(""))))="" Q $$GET1^DIQ(50,$O(PSODRFLT("")),.01)
  1.  I TYPE="I",$O(PSOINFLT($O(PSOINFLT(""))))="" Q $O(PSOINFLT(""))
  1.  I TYPE="R" Q $$GET1^DIQ(52,PSORXFLT,.01)
  1.  Q "MULTIPLE "_$S(TYPE="P":"PATIENTS",TYPE="D":"DRUGS",1:"INSURANCE COMPANIES")
  1.  ;
  1. ENDT() ; Returns the upper limit for the date range
  1.  N ENDT
  1.  S ENDT=$P(PSODTRNG,"^",2)
  1.  I '$E(ENDT,4,7) Q (ENDT+10000)
  1.  I '$E(ENDT,6,7) Q (ENDT+100)
  1.  I $P(ENDT,"^",2) Q (ENDT+0.0000001)
  1.  Q (ENDT+.25)