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

PSOREJP2.m

Go to the documentation of this file. 
  1. PSOREJP2 ;BIRM/MFR - Third Party Rejects View/Process ;04/28/05
  1.  ;;7.0;OUTPATIENT PHARMACY;**148,247,260,287,289**;DEC 1997;Build 107
  1.  ;Reference to ^PSSLOCK supported by IA #2789
  1.  ; 
  1.  N PSORJSRT,PSOPTFLT,PSODRFLT,PSORXFLT,PSOBYFLD,PSOSTFLT,DIR,DIRUT,DUOUT,DTOUT
  1.  N PSOINFLT,PSODTRNG,PSOINGRP,PSOTRITG
  1.  S PSORJASC=1,PSOINGRP=0,PSOTRITG=1
  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.  ; - Date range selection
  1.  W ! S PSODTRNG=$$DTRNG("T-90","T") I PSODTRNG="^" G EXIT
  1.  ;
  1. SEL ; - Field Selection (Patient/Drug/Rx)
  1.  S DIR(0)="S^P:PATIENT;D:DRUG;R:Rx;I:INSURANCE",DIR("B")="P"
  1.  S DIR("A")="By (P)atient, (D)rug, (R)x or (I)nsurance" D ^DIR I $D(DIRUT) G EXIT
  1.  S PSOBYFLD=Y,DIR("B")=""
  1.  ;
  1.  I PSOBYFLD="P" D  I $G(PSOPTFLT)="^" G SEL
  1.  . S (PSODRFLT,PSORXFLT,PSOINFLT)="ALL",PSORJSRT="DR"
  1.  . D SEL^PSOREJU1("PATIENT","^DPT(",.PSOPTFLT)
  1.  ;
  1.  I PSOBYFLD="D" D  I $G(PSODRFLT)="^" G SEL
  1.  . S (PSOPTFLT,PSORXFLT,PSOINFLT)="ALL",PSORJSRT="PA"
  1.  . D SEL^PSOREJU1("DRUG","^PSDRUG(",.PSODRFLT)
  1.  ;
  1.  I PSOBYFLD="R" D  I $D(DUOUT)!$D(DTOUT)!'$G(PSORXFLT) G SEL
  1.  . S (PSOPTFLT,PSODRFLT,PSOINFLT)="ALL",PSORJSRT="PA"
  1.  . N DIC,Y,X,OK K PSOSTFLT,PSORXFLT
  1.  . S DIC=52,DIC(0)="QEZA",DIC("A")="PRESCRIPTION: "
  1.  . F  W ! D ^DIC D  Q:$G(OK) 
  1.  . . I $D(DUOUT)!$D(DTOUT)!(X="") S OK=1 Q
  1.  . . I '$O(^PSRX(+Y,"REJ",0)) D  Q
  1.  . . . W !?40,"Prescription does not have rejects!",$C(7)
  1.  . . S PSORXFLT=+Y,OK=1
  1.  ;
  1.  I PSOBYFLD="I" D  I $O(PSOINFLT(""))="" G SEL
  1.  . S (PSOPTFLT,PSODRFLT,PSORXFLT)="ALL",PSORJSRT="PA"
  1.  . N DIR,Y,X,OK K PSOINFLT W !
  1.  . S DIR("A",1)="Enter the whole or part of the Insurance Company"
  1.  . S DIR("A",2)="name for which you want to view/process REJECTS."
  1.  . S DIR("A",3)=""
  1.  . S DIR(0)="FO^3:30",DIR("A")="  INSURANCE"
  1.  . F  D ^DIR D  Q:$G(OK) 
  1.  . . I $D(DIRUT)!(X="") S OK=1 Q
  1.  . . S PSOINFLT(X)="" K DIR("A") S DIR("A")="ANOTHER ONE"
  1.  ;
  1.  ; - Status Selection (UNRESOLVED or RESOLVED)
  1.  I $G(PSOSTFLT)="" D  I $D(DIRUT) G EXIT
  1.  . S DIR(0)="S^U:UNRESOLVED;R:RESOLVED;B:BOTH",DIR("B")="B"
  1.  . S DIR("A")="(U)NRESOLVED, (R)RESOLVED or (B)OTH REJECT statuses" D ^DIR
  1.  . S PSOSTFLT=Y
  1.  ;
  1.  D LST^PSOREJP0("VP")
  1.  ;
  1. EXIT Q
  1.  ;
  1. CLO      ; - Ignore a REJECT hidden action
  1.  N PSOTRIC,X
  1.  S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,FILL,PSOTRIC)
  1.  I $G(PSOTRIC) S VALMSG="INVALID: TRICARE rejected Rxs may not be ignored.",VALMBCK="R" Q
  1.  I $$CLOSED^PSOREJP1(RX,REJ) D  Q
  1.  . S VALMSG="This Reject is marked resolved!",VALMBCK="R"
  1.  N DIR,COM
  1.  D FULL^VALM1
  1.  I '$$SIG^PSOREJU1() S VALMBCK="R" Q
  1.  W !
  1.  S COM=$$COM^PSOREJU1() I COM="^" S VALMBCK="R" Q
  1.  W !
  1.  S DIR(0)="Y",DIR("A")="     Confirm? ",DIR("B")="NO"
  1.  S DIR("A",1)="     When you confirm this REJECT will be marked RESOLVED."
  1.  S DIR("A",2)=" "
  1.  D ^DIR I $G(Y)=0!$D(DIRUT) S VALMBCK="R" Q
  1.  W ?40,"[Closing..." D CLOSE^PSOREJUT(RX,FILL,REJ,DUZ,6,COM) W "OK]",!,$C(7) H 1
  1.  I $D(PSOSTFLT),PSOSTFLT'="B" S CHANGE=1
  1.  ;
  1.  I $$PTLBL(RX,FILL) D PRINT^PSOREJP3(RX,FILL)
  1.  ;
  1.  Q
  1.  ;
  1. OPN ; - Re-open a Closed/Resolved Reject
  1.  I '$$CLOSED^PSOREJP1(RX,REJ) D  Q
  1.  . S VALMSG="This Reject is NOT marked resolved!",VALMBCK="R"
  1.  N DIR,COM,REJDATA,NEWDATA,X,REOPEN
  1.  D FULL^VALM1
  1.  I '$$SIG^PSOREJU1() S VALMBCK="R" Q
  1.  W !
  1.  S DIR(0)="Y",DIR("A")="     Confirm",DIR("B")="NO"
  1.  S DIR("A",1)="     When you confirm this REJECT will be marked UNRESOLVED."
  1.  S DIR("A",2)=" "
  1.  D ^DIR I $G(Y)=0!$D(DIRUT) S VALMBCK="R" Q
  1.  ;
  1.  W ?40,"[Re-opening..."
  1.  K REJDATA D GET^PSOREJU2(RX,FILL,.REJDATA,REJ,1) D SETOPN^PSOREJU2(RX,REJ)
  1.  K NEWDATA M NEWDATA=REJDATA(REJ) S NEWDATA("PHARMACIST")=DUZ
  1.  S REOPEN=1 D SAVE^PSOREJUT(RX,FILL,.NEWDATA,REOPEN)
  1.  I $G(NEWDATA("REJECT IEN")),$D(REJDATA(REJ,"COMMENTS")) D
  1.  . S COM=0 F  S COM=$O(REJDATA(REJ,"COMMENTS",COM)) Q:'COM  D
  1.  . . S X(1)=REJDATA(REJ,"COMMENTS",COM,"COMMENTS")
  1.  . . S X(2)=REJDATA(REJ,"COMMENTS",COM,"DATE/TIME")
  1.  . . S X(3)=REJDATA(REJ,"COMMENTS",COM,"USER")
  1.  . . D SAVECOM^PSOREJP3(RX,NEWDATA("REJECT IEN"),X(1),X(2),X(3))
  1.  D RETRXF^PSOREJU2(RX,FILL,0)
  1.  W "OK]",!,$C(7) H 1
  1.  S CHANGE=1
  1.  Q
  1.  ;
  1. CHG ; - Change Suspense Date action
  1.  I $$CLOSED^PSOREJP1(RX,REJ) D  Q
  1.  . S VALMSG="This Reject is marked resolved!",VALMBCK="R" W $C(7)
  1.  ;
  1.  N SUSDT,PSOMSG,Y,SUSRX,%DT,DA,DIE,DR,ISSDT,EXPDT,PSOMSG,CUTDT,FILDT
  1.  ;
  1.  S RFL=+$$GET1^DIQ(52.25,REJ_","_RX,5),SUSDT=$$RXSUDT^PSOBPSUT(RX,RFL)
  1.  I RFL>0 S FILDT=$$GET1^DIQ(52.1,RFL_","_RX,.01,"I")
  1.  E  S FILDT=$$GET1^DIQ(52,RX,22,"I")
  1.  I SUSDT="" S VALMSG="Prescription is not suspended!",VALMBCK="R" W $C(7) Q
  1.  I $$RXRLDT^PSOBPSUT(RX,RFL) S VALMSG="Prescription has been released already!",VALMBCK="R" W $C(7) Q
  1.  D PSOL^PSSLOCK(RX) I '$G(PSOMSG) S VALMSG=$P(PSOMSG,"^",2),VALMBCK="R" W $C(7) Q
  1.  ;
  1.  S ISSDT=$$GET1^DIQ(52,RX,1,"I"),EXPDT=$$GET1^DIQ(52,RX,26,"I")
  1.  S SUSRX=$O(^PS(52.5,"B",RX,0))
  1.  ;
  1. SUDT ; Asks for the new Suspense Date
  1.  S X1=FILDT,X2=+89 D C^%DTC S CUTDT=X
  1.  D FULL^VALM1 S %DT("B")=$$FMTE^XLFDT(SUSDT),%DT="EA",%DT("A")="SUSPENSE DATE: "
  1.  W ! D ^%DT I Y<0!($D(DTOUT)) D PSOUL^PSSLOCK(RX) S VALMBCK="R" Q
  1.  I Y<ISSDT D  G SUDT
  1.  . W !!?5,"Suspense Date cannot be before Issue Date: ",$$FMTE^XLFDT(ISSDT),".",$C(7)
  1.  I Y>EXPDT D  G SUDT
  1.  . W !!?5,"Suspense Date cannot be after Expiration Date: ",$$FMTE^XLFDT(EXPDT),".",$C(7)
  1.  I Y>CUTDT D  G SUDT
  1.  . W !!?5,"Suspense Date cannot be after fill date plus 90 days: "_$$FMTE^XLFDT(CUTDT),".",$C(7)
  1.  S SUSDT=Y
  1.  ;
  1.  N DIR,DIRUT W !
  1.  S DIR("A",1)="     When you confirm, this REJECT will be marked resolved. A"
  1.  S DIR("A",2)="     new claim will be re-submitted to the 3rd party payer"
  1.  I $$GET1^DIQ(52.5,SUSRX,3)="" D
  1.  . I SUSDT>DT D
  1.  . . S DIR("A",3)="     when the prescription label for this fill is printed"
  1.  . . S DIR("A",4)="     from suspense on "_$$FMTE^XLFDT(SUSDT)_"."
  1.  . . S DIR("A",5)=" "
  1.  . . S DIR("A",6)="     Note: THE LABEL FOR THIS PRESCRIPTION FILL WILL NOT BE"
  1.  . . S DIR("A",7)="           PRINTED LOCAL FROM SUSPENSE BEFORE "_$$FMTE^XLFDT(SUSDT)_"."
  1.  . E  D
  1.  . . S DIR("A",3)="     the next time local labels are printed from suspense."
  1.  E  D
  1.  . I SUSDT>DT D
  1.  . . S DIR("A",3)="     when the prescription is transmitted to CMOP on "
  1.  . . S DIR("A",4)="     "_$$FMTE^XLFDT(SUSDT)_"."
  1.  . . S DIR("A",5)=" "
  1.  . . S DIR("A",6)="     Note: THIS PRESCRIPTION FILL WILL NOT BE TRANSMITTED TO"
  1.  . . S DIR("A",7)="           CMOP BEFORE "_$$FMTE^XLFDT(SUSDT)_"."
  1.  . E  D
  1.  . . S DIR("A",3)="     when this prescription fill is transmitted to CMOP on"
  1.  . . S DIR("A",4)="     the next CMOP transmission."
  1.     ;
  1.  S DIR("A",$O(DIR("A",""),-1)+1)=" "
  1.  S DIR(0)="Y",DIR("A")="     Confirm? ",DIR("B")="YES"
  1.  D ^DIR I $G(Y)=0!$D(DIRUT) S VALMBCK="R" D PSOUL^PSSLOCK(RX) Q
  1.  ;
  1.  ; - Suspense/Fill Date updates
  1.  I SUSDT'=$$RXSUDT^PSOBPSUT(RX,RFL) D
  1.  . N DA,DIE,DR,PSOX,SFN,INDT,DEAD
  1.  . S DA=SUSRX,DIE="^PS(52.5,",DR=".02///"_SUSDT D ^DIE
  1.  . S SFN=SUSRX,DEAD=0,INDT=SUSDT D CHANGE^PSOSUCH1(RX,RFL)
  1.  ;
  1.  ; - Flagging the prescription to be re-submitted to ECME on the next CMOP/Print from Suspense
  1.  D RETRXF^PSOREJU2(RX,RFL,1)
  1.  W ?40,"[Closing..."
  1.  D CLOSE^PSOREJUT(RX,RFL,REJ,DUZ,8,"Fill Date changed to "_$$FMTE^XLFDT(SUSDT)_". A new claim will be re-submitted on this date.")
  1.  W "OK]",!,$C(7) H 1 I $D(PSOSTFLT),PSOSTFLT'="B" S CHANGE=1
  1.  D PSOUL^PSSLOCK(RX)
  1.  Q
  1.  ;
  1. PTLBL(RX,RFL) ; Returns whether the user should be prompted for 'Print Label?' or not
  1.  N PTLBL,CMP,LBL,REPRINT
  1.  N PSOTRIC S PSOTRIC="",PSOTRIC=$$TRIC^PSOREJP1(RX,RFL,.PSOTRIC)
  1.  I $$FIND^PSOREJUT(RX,RFL) Q 0       ; Has OPEN/UNRESOLVED 3rd pary payer reject
  1.  I $$GET1^DIQ(52,RX,100,"I") Q 0     ; Rx status not ACTIVE
  1.  I $$RXRLDT^PSOBPSUT(RX,RFL),'PSOTRIC Q 0     ; Rx Released
  1.  ; - CMOP Rx fill?
  1.  S PTLBL=1,CMP=0
  1.  F  S CMP=$O(^PSRX(RX,4,CMP)) Q:'CMP  D  Q:'PTLBL
  1.  . I +$$GET1^DIQ(52.01,CMP_","_RX,2,"I")=RFL S PTLBL=0
  1.  I 'PTLBL Q 0
  1.  ; - Label already printed for Rx fill?
  1.  S LBL=0
  1.  F  S LBL=$O(^PSRX(RX,"L",LBL)) Q:'LBL  D  Q:'PTLBL
  1.  . I +$$GET1^DIQ(52.032,LBL_","_RX,1,"I")'=RFL Q
  1.  . I $G(PSOTRIC)&($$RXRLDT^PSOBPSUT(RX,RFL)) S REPRINT=1 Q
  1.  . I $$GET1^DIQ(52.032,LBL_","_RX,4,"I") Q
  1.  . I $$GET1^DIQ(52.032,LBL_","_RX,2)["INTERACTION" Q
  1.  . S PTLBL=0
  1.  ;
  1.  I PTLBL D
  1.  . N DIR,DIRUT,Y
  1.  . W ! S DIR(0)="Y",DIR("A")=$S('$G(REPRINT):"Print Label",1:"Reprint Label"),DIR("B")="YES"
  1.  . D ^DIR I $G(Y)=0!$D(DIRUT) S PTLBL=0 Q
  1.  ;
  1.  Q PTLBL
  1.  ;
  1. DTRNG(BGN,END) ; Date Range Selection
  1.  ;Input: (o) BGN - Default Begin Date 
  1.  ;       (o) END - Default End Date 
  1.  ;
  1.  N %DT,DTOUT,DUOUT,DTRNG,X,Y
  1.  S DTRNG=""
  1.  S %DT="AEST",%DT("A")="BEGIN REJECT DATE: ",%DT("B")=$G(BGN) K:$G(BGN)="" %DT("B") D ^%DT
  1.  I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
  1.  S $P(DTRNG,U)=Y
  1.  ;
  1.  W ! K %DT
  1.  S %DT="AEST",%DT("A")="END REJECT DATE: ",%DT("B")=$G(END),%DT(0)=Y K:$G(END)="" %DT("B") D ^%DT
  1.  I $G(DUOUT)!$G(DTOUT)!($G(Y)=-1) Q "^"
  1.  ;
  1.  ;Define Entry
  1.  S $P(DTRNG,U,2)=Y
  1.  ;
  1.  Q DTRNG