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

PSOBPSU3.m

Go to the documentation of this file.
  1. PSOBPSU3 ;ALB/CFS - BPS (ECME) Utilities 3 ;08/27/15
  1. ;;7.0;OUTPATIENT PHARMACY;**448,482,512**;DEC 1997;Build 44
  1. ; Reference to ^BPSVRX supported by IA #5723
  1. ; Reference to ^BPSPSOU1 supported by IA #6248
  1. ; Reference to $$ADDLFLDS^BPSRES1 supported by IA #6938
  1. ; Reference to $$SAVE^BPSRES1 supported by IA #6938
  1. ;
  1. RES(RXIEN,DFN) ; Resubmit a claim action from PSO HIDDEN ACTIONS
  1. N ACTION,DIRUT,PSOCOB,PSOFILL,PSOFL,PSOFLZ,PSOELIG,REVREAS,VALID
  1. S PSOFILL=$$FILL(RXIEN,DFN,.PSOFL)
  1. I $D(DIRUT) G END
  1. I PSOFILL="" W !!,"No claim was ever submitted for this prescription. Cannot resubmit." D PAUSE^VALM1 G END
  1. S PSOELIG=$$ELIGDISP^PSOREJP1(RXIEN,PSOFILL)
  1. ; Validate the claim.
  1. S VALID=$$VAL^BPSPSOU1(RXIEN,PSOFILL,PSOELIG,"RES",.PSOCOB,.REVREAS) ;DBIA #6248
  1. I 'VALID G END
  1. I $$RXDEL(RXIEN,PSOFILL) D D PAUSE^VALM1 G END
  1. . W !!,"The claim cannot be Resubmitted since it has been deleted in Pharmacy."
  1. ; Resubmit the claim to ECME
  1. D ECMESND^PSOBPSU1(RXIEN,PSOFILL,,"ED",,,"RESUBMIT FROM RX EDIT SCREEN","","","","","","","",$G(PSOCOB))
  1. I $$PTLBL^PSOREJP2(RXIEN,PSOFILL) S PSORX("PSOL",1)=RXIEN_"," ; Add Rx to Queue List
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. FILL(RXIEN,DFN,PSOFL) ;
  1. N CNT,DIR,FILL,FLDT,PSOELIG,PSOET,PSOSTR,REFILL,RELDT,RF,RXNUM,X,Y
  1. D FULL^VALM1
  1. I '$G(RXIEN)!'$G(DFN) Q ""
  1. ;
  1. S RXNUM=$P($G(^PSRX(RXIEN,0)),U)
  1. K PSOFL,PSOFLZ
  1. ; Get refill dates and release dates
  1. S REFILL=0 F S REFILL=$O(^PSRX(RXIEN,1,REFILL)) Q:'REFILL D
  1. . S FLDT=$P($G(^PSRX(RXIEN,1,REFILL,0)),U)\1
  1. . S RELDT=$P($G(^PSRX(RXIEN,1,REFILL,0)),U,18)\1
  1. . S PSOFLZ(REFILL)=FLDT_U_RELDT
  1. ; Get orignal RX fill date and release date
  1. S FLDT=$P($G(^PSRX(RXIEN,2)),U)\1
  1. S RELDT=$P($G(^PSRX(RXIEN,2)),U,13)\1
  1. S PSOFLZ(0)=FLDT_U_RELDT
  1. ; Check for any deleted fills that have ECME activity
  1. D RFL^BPSVRX(RXIEN,.PSOFL) ; DBIA #5723
  1. I '$D(PSOFL) Q "" ; Not in BPS transaction file.
  1. S RF="" F S RF=$O(PSOFL(RF)) Q:RF="" I '$D(PSOFLZ(RF)) S PSOFLZ(RF)=0_U_0
  1. ;
  1. S DIR(0)="S"
  1. S DIR("L",1)="Rx# "_RXNUM_" has the following fills:"
  1. S DIR("L",2)=""
  1. S DIR("L",3)=" Fill# Fill Date Release Date"
  1. S DIR("L",4)=" ----- ---------- ------------"
  1. S CNT=0,PSOSTR=""
  1. S RF="" F S RF=$O(PSOFLZ(RF)) Q:RF="" D
  1. . S CNT=CNT+1
  1. . S FLDT=$$FMTE^XLFDT($P(PSOFLZ(RF),U,1),"5Z") I 'FLDT S FLDT=" - "
  1. . S RELDT=$$FMTE^XLFDT($P(PSOFLZ(RF),U,2),"5Z") I 'RELDT S RELDT=" - "
  1. . I 'FLDT,'RELDT S (FLDT,RELDT)=" Deleted "
  1. . S $P(PSOSTR,";",CNT)=RF_":"_FLDT_" "_RELDT
  1. . S DIR("L",CNT+4)=$J(RF,7)_" "_FLDT_" "_RELDT
  1. . Q
  1. S DIR("L")=" "
  1. S $P(DIR(0),U,2)=PSOSTR
  1. S DIR("A")="Select Fill Number"
  1. S DIR("B")=$O(PSOFLZ(""),-1)
  1. I CNT=1 D
  1. . S $P(DIR("L",1)," ",$L(DIR("L",1)," "))="fill:" ; singular
  1. . Q
  1. W ! D ^DIR K DIR
  1. S FILL=Y
  1. Q FILL
  1. ;
  1. VER(RXIEN,DFN) ; -- VER hidden action under protocol PSO HIDDEN ACTIONS
  1. D FULL^VALM1
  1. K ^TMP("PSOHDR_ARCHIVE",$J)
  1. M ^TMP("PSOHDR_ARCHIVE",$J)=^TMP("PSOHDR",$J)
  1. S BPSVRX("RXIEN")=RXIEN
  1. D ^BPSVRX ;DBIA #5723
  1. M ^TMP("PSOHDR",$J)=^TMP("PSOHDR_ARCHIVE",$J)
  1. K ^TMP("PSOHDR_ARCHIVE",$J)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. REV(RXIEN,DFN) ; Reverse a claim action from PSO HIDDEN ACTIONS
  1. N DIRUT,PSOCOB,PSOFILL,PSOFL,PSOFLZ,PSOELIG,REVREAS,VALID
  1. S PSOFILL=$$FILL(RXIEN,DFN,.PSOFL)
  1. I $D(DIRUT) G END
  1. I PSOFILL="" W !!,"No claim was ever submitted for this prescription. Cannot reverse." D PAUSE^VALM1 G END
  1. S PSOELIG=$$ELIGDISP^PSOREJP1(RXIEN,PSOFILL)
  1. ; Validate the claim.
  1. S VALID=$$VAL^BPSPSOU1(RXIEN,PSOFILL,PSOELIG,"REV",.PSOCOB,.REVREAS) ;DBIA #6248
  1. I 'VALID G END
  1. I $$RXDEL(RXIEN,PSOFILL) D D PAUSE^VALM1 G END
  1. . W !!,"The claim cannot be Reversed since it has been deleted in Pharmacy."
  1. ; Submit the reversal to ECME
  1. D ECMESND^PSOBPSU1(RXIEN,PSOFILL,"","OREV","","",REVREAS,"","","","","","","",$G(PSOCOB))
  1. D PAUSE^VALM1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. RXDEL(RXIEN,PSOFILL) ; EP - $$ is RX deleted?
  1. ; For refills: if the refill multiple is gone, it's been "deleted"
  1. I $G(PSOFILL),'$P($G(^PSRX(RXIEN,1,PSOFILL,0)),U) Q 1
  1. ; For first fill: look at the STATUS flag
  1. I $P($G(^PSRX(RXIEN,0)),U,1)="" Q 1 ; shouldn't be missing but is
  1. N X S X=$P($G(^PSRX(RXIEN,"STA")),U,1)
  1. Q X=13 ; if status is DELETED
  1. ;
  1. END ;
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ECS(PSORX,PSOFILL,PSOSCREEN) ; Edit Claim to be Submitted.
  1. ;
  1. ; Input: PSORX = Prescription IEN, pointer to file #52, ^PSRX
  1. ; PSOFILL = Refill#. If not passed in, then the user
  1. ; will be prompted to select a fill.
  1. ; PSOSCREEN = 1 if coming from the Medication Profile
  1. ; Screen, 2 if coming from the Reject Info Screen
  1. ;
  1. ; This entry point is associated with the action ECS Edit Claim
  1. ; Submitted. The user is asked to select a date to be used as the
  1. ; date of service on the claim. The user is then able to select
  1. ; one or more NCPDP fields to be added to the claim. The claim is
  1. ; then resubmitted.
  1. ;
  1. N DIR,DIRUT,PSOADDLFLDS,PSOALTXT,PSOCLAIM,PSOCOB,PSODATESELECTED
  1. N PSODOS,PSOELIG,PSOIEN59,PSOQUIT,PSORESPONSE,PSOVALID,PSOVRIEN
  1. S PSOCOB=""
  1. S PSOQUIT=0
  1. ;
  1. I '$D(@(VALMAR)) G ECSQUIT
  1. D FULL^VALM1
  1. ;
  1. ; If Fill was not passed in, then prompt the user to select a fill.
  1. ; If the user exited out or there was not a fill with ECME activity,
  1. ; then exit out.
  1. ;
  1. I $G(PSOFILL)="" D I PSOQUIT=-1 G ECSQUIT
  1. . S PSOFILL=$$FILL(PSORX,DFN)
  1. . I $D(DIRUT) S PSOQUIT=-1 Q
  1. . I PSOFILL="" D
  1. . . W !!,"No claim was ever submitted for this prescription. Cannot resubmit."
  1. . . D PAUSE^VALM1
  1. . . S PSOQUIT=-1
  1. . . Q
  1. . Q
  1. ;
  1. ; Determine the Transaction IEN and Claim IEN.
  1. ;
  1. S PSOIEN59=$$CLAIM^BPSBUTL(PSORX,PSOFILL) ; ICR# 4719
  1. S PSOCLAIM=$P(PSOIEN59,U,2)
  1. S PSOIEN59=$P(PSOIEN59,U,1)
  1. I PSOIEN59=""!(PSOCLAIM="") D G ECSQUIT
  1. . W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Re-"
  1. . W !,"Submission"
  1. . D PAUSE^VALM1
  1. . Q
  1. ;
  1. ; Disallow resubmission if Fill or Rx has been deleted.
  1. ;
  1. I $$RXDEL(PSORX,PSOFILL) D G ECSQUIT
  1. . W !!,"The claim cannot be Resubmitted since it has been deleted in Pharmacy."
  1. . D PAUSE^VALM1
  1. . Q
  1. ;
  1. ; $$VAL^BPSPSOU1 performs several checks to determine whether the
  1. ; claim can be resubmitted.
  1. ;
  1. S PSOELIG=$$ELIGDISP^PSOREJP1(PSORX,PSOFILL)
  1. S PSOVALID=$$VAL^BPSPSOU1(PSORX,PSOFILL,PSOELIG,"RES",.PSOCOB,"",1) ; ICR# 6248
  1. I 'PSOVALID G ECSQUIT
  1. ;
  1. W !!,"Enter ^ at any prompt to exit"
  1. ;
  1. ; If there is an unresolved reject for this Rx/Fill, ask user to
  1. ; confirm that they wish to resolve the reject and resubmit a claim.
  1. ;
  1. S PSOQUIT=0
  1. I $$FIND^PSOREJUT(PSORX,PSOFILL) D I PSOQUIT'=1 G ECSQUIT
  1. . W !!," When you confirm, a new claim will be submitted for"
  1. . W !," the prescription and this REJECT will be marked"
  1. . W !," resolved."
  1. . S PSOQUIT=$$YESNO^PSOREJP3(" Confirm","YES")
  1. . Q
  1. ;
  1. ; Allow user to select a date to use as the Date of Service.
  1. ; PSODATESELECTED will be reset to 1 if the user is prompted to
  1. ; select a date within $$EDITDT and the user selected a date
  1. ; not equal to the Release Date; otherwise it will be left as 0.
  1. ;
  1. S PSOALTXT=""
  1. S PSODATESELECTED=0
  1. S PSODOS=$$EDITDT(PSORX,PSOFILL,PSOCOB,PSOCLAIM,PSOIEN59,.PSOALTXT,.PSODATESELECTED)
  1. I PSODOS="^" G ECSQUIT
  1. ;
  1. ; Allow user to add to the claim additional fields which are
  1. ; not on the payer sheet.
  1. ;
  1. S PSOQUIT=$$ADDLFLDS^BPSRES1(PSOCLAIM,PSOIEN59,.PSOADDLFLDS,$S(PSODATESELECTED:PSODOS,1:"")) ; IA 6938
  1. I PSOQUIT=-1 G ECSQUIT
  1. ;
  1. ; If the user did not add any additional NCPDP fields to the claim
  1. ; ('PSOQUIT), and the user did not select a data of service
  1. ; ('PSODATESELECTED), then display a message and Quit.
  1. ;
  1. I 'PSOQUIT,'PSODATESELECTED D G ECSQUIT
  1. . W !!,"No value changed. A claim will not be submitted.",!
  1. . N DIR
  1. . S DIR(0)="E"
  1. . S DIR("A")="Press enter to continue"
  1. . D ^DIR
  1. . Q
  1. ;
  1. ; Require the user to confirm they wish to continue.
  1. ;
  1. W !!,"A claim will be submitted now."
  1. S PSOQUIT=$$YESNO^PSOREJP3("Are you sure (Y/N)","Y")
  1. I PSOQUIT'=1 G ECSQUIT
  1. ;
  1. ; Save the list of additional fields in file# 9002313.511,
  1. ; BPS NCPDP OVERRIDES.
  1. ;
  1. I $D(PSOADDLFLDS) D I PSOQUIT=-1 G ECSQUIT
  1. . S PSOQUIT=$$SAVE^BPSRES1("ECS",PSOIEN59,.PSOADDLFLDS,.PSOVRIEN) ; IA 6938
  1. . Q
  1. ;
  1. ; Call ECMESND^PSOBPSU1 to reverse the existing claim and submit a new
  1. ; claim. The additional fields indicated by the user will be added to
  1. ; the claim in XLOOP^BPSOSCF and XLOOP^BPSOSH2.
  1. ;
  1. D ECMESND^PSOBPSU1(PSORX,PSOFILL,PSODOS,"ED","","","RX EDITED","","",.PSORESPONSE,"",PSOALTXT,"","",PSOCOB,$G(PSOVRIEN(1)))
  1. ;
  1. ; If the claim submission was unsuccessful, then PSORESPONSE will
  1. ; not be blank. Display the reason it failed, then quit out.
  1. ;
  1. I $G(PSORESPONSE) D G ECSQUIT
  1. . W !!?10,"Claim could not be submitted. Please try again later!"
  1. . W !,?10,"Reason: ",$S($P(PSORESPONSE,"^",2)="":"UNKNOWN",1:$P(PSORESPONSE,"^",2)),$C(7)
  1. . D PAUSE^VALM1
  1. . Q
  1. ;
  1. ; Conditionally prompt the user "Print Label?". If user wishes to
  1. ; print a label, then either put the Rx on queue to be printed when
  1. ; the user leaves the screen (if on Medication Profile Screen) or
  1. ; print the label now (if on the Reject Info Screen).
  1. ;
  1. I $$PTLBL^PSOREJP2(PSORX,PSOFILL) D
  1. . I PSOSCREEN=1 S PSORX("PSOL",1)=PSORX_","
  1. . I PSOSCREEN=2 D PRINT^PSOREJP3(PSORX,PSOFILL)
  1. . Q
  1. ;
  1. ; If on the Reject Info Screen, then if the Status Filter
  1. ; (PSOSTFLT) is not "B"oth, set the CHANGE flag to 1, which
  1. ; will cause the screen to be rebuilt.
  1. ;
  1. I PSOSCREEN=2,$D(PSOSTFLT),PSOSTFLT'="B" S CHANGE=1
  1. ;
  1. D PAUSE^VALM1
  1. ;
  1. ECSQUIT ;
  1. ;
  1. S VALMBCK="R"
  1. ;
  1. Q
  1. ;
  1. EDITDT(PSORX,PSOFILL,PSOCOB,PSOCLAIM,PSOIEN59,PSOALTXT,PSODATESELECTED) ; Allow user to select Date of Service.
  1. ;
  1. ; Input: PSORX = Prescription IEN, pointer to file# 52, ^PSRX
  1. ; PSOFILL = Refill#. If not passed in, then the user
  1. ; PSOCOB = COB (1=Primary, etc.)
  1. ; PSOCLAIM = Claim IEN, pointer to file# 9002313.02, ^BPSC
  1. ; PSOIEN59 = Transaction IEN, pointer to file# 9002313.59
  1. ;
  1. ; Output: Selected Date of Service, in FileMan format
  1. ; PSOALTXT = Passed by reference; populate if user
  1. ; selects the Release Date
  1. ; PSODATESELECTED = Passed by reference; set to '1' if
  1. ; the user selected a date different from the Release
  1. ; Date.
  1. ;
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT
  1. N PSOCLAIM2,PSODATE,PSODATEARRAY,PSODESC,PSOFILLDT
  1. N PSOIEN57,PSORELEASEDT,PSOTEMP,X,Y
  1. ;
  1. ; Determine the Release Date, the Fill Date, and all Dates of Service.
  1. ; In order to present the entire list to the user in chronological
  1. ; order, they will be put into an array.
  1. ;
  1. S PSORELEASEDT=$$RXRLDT^PSOBPSUT(PSORX,PSOFILL)\1
  1. I +PSORELEASEDT=0 D Q DT
  1. . S X=$$FMTE^XLFDT(DT,"5D")
  1. . W !!,"Rx is not released. Date of Service will be ",X,"."
  1. . S PSOALTXT="Date of Service ("_X_")"
  1. . Q
  1. S PSODATEARRAY(PSORELEASEDT,3)="Release Date"
  1. S PSOFILLDT=$$RXFLDT^PSOBPSUT(PSORX,PSOFILL)\1
  1. I PSOFILLDT'="" S PSODATEARRAY(PSOFILLDT,1)="Fill Date"
  1. ;
  1. ; Add to the array each Date of Service from all previous Claims,
  1. ; which are identified by looping through all entries in the BPS Log
  1. ; of Transactions file for the current BPS Transaction and pulling
  1. ; the Claim for each entry and the Date of Service for that Claim.
  1. ;
  1. S PSOIEN57=0
  1. F S PSOIEN57=$O(^BPSTL("B",PSOIEN59,PSOIEN57)) Q:'PSOIEN57 D
  1. . S PSOCLAIM2=$$GET1^DIQ(9002313.57,PSOIEN57,3,"I")
  1. . S PSODATE=$$HL7TFM^XLFDT($$GET1^DIQ(9002313.02,PSOCLAIM2,401))
  1. . I PSODATE'="" S PSODATEARRAY(PSODATE,2)="Date of Service"
  1. . Q
  1. ;
  1. ; If the dates are all the same, then the user is not
  1. ; allowed to select a date.
  1. ;
  1. S PSODATE=$O(PSODATEARRAY(""))
  1. I $O(PSODATEARRAY(PSODATE))="" D Q PSODATE
  1. . W !
  1. . S X=0
  1. . F S X=$O(PSODATEARRAY(PSODATE,X)) Q:'X D
  1. . . W !,?10,$$FMTE^XLFDT(PSODATE,"5D")," ",PSODATEARRAY(PSODATE,X)
  1. . . Q
  1. . W !!,"Claim will be submitted with ",$$FMTE^XLFDT(PSODATE,"5D")," Date of Service."
  1. . S PSOALTXT="Date of Service ("_$$FMTE^XLFDT(PSODATE,"5D")_")"
  1. . Q
  1. ;
  1. S DIR("?",1)=" Enter a date of service to override the date algorithm."
  1. S DIR("?")=" The date algorithm will use the release date as a default value."
  1. S DIR("A")="Date of Service"
  1. S DIR("B")=1
  1. S DIR(0)="S^"
  1. S Y=0
  1. S PSODATE=0
  1. F S PSODATE=$O(PSODATEARRAY(PSODATE)) Q:'PSODATE D
  1. . S X=0
  1. . F S X=$O(PSODATEARRAY(PSODATE,X)) Q:'X D
  1. . . S Y=Y+1
  1. . . S PSOTEMP(Y)=PSODATE
  1. . . S PSODESC=PSODATEARRAY(PSODATE,X)
  1. . . S DIR(0)=DIR(0)_Y_":"_$$FMTE^XLFDT(PSODATE,"5D")_" "_PSODESC_";"
  1. . . I PSODESC="Release Date" S DIR("B")=Y
  1. . . Q
  1. . Q
  1. ;
  1. D ^DIR
  1. I $D(DIRUT) Q "^"
  1. ;
  1. ; If we get here, the user selected a date. Set the PSODATESELECTED
  1. ; flag to 1 if the user selected a date other than the Release Date
  1. ; and set PSOALTXT, which will eventually be put on the Activity Log.
  1. ;
  1. I Y'=DIR("B") S PSODATESELECTED=1
  1. S PSOALTXT="Date of Service ("_$$FMTE^XLFDT(PSOTEMP(Y),"5D")_")"
  1. ;
  1. Q PSOTEMP(Y)
  1. ;