- PSOBPSU3 ;ALB/CFS - BPS (ECME) Utilities 3 ;08/27/15
- ;;7.0;OUTPATIENT PHARMACY;**448,482,512**;DEC 1997;Build 44
- ; Reference to ^BPSVRX supported by IA #5723
- ; Reference to ^BPSPSOU1 supported by IA #6248
- ; Reference to $$ADDLFLDS^BPSRES1 supported by IA #6938
- ; Reference to $$SAVE^BPSRES1 supported by IA #6938
- ;
- RES(RXIEN,DFN) ; Resubmit a claim action from PSO HIDDEN ACTIONS
- N ACTION,DIRUT,PSOCOB,PSOFILL,PSOFL,PSOFLZ,PSOELIG,REVREAS,VALID
- S PSOFILL=$$FILL(RXIEN,DFN,.PSOFL)
- I $D(DIRUT) G END
- I PSOFILL="" W !!,"No claim was ever submitted for this prescription. Cannot resubmit." D PAUSE^VALM1 G END
- S PSOELIG=$$ELIGDISP^PSOREJP1(RXIEN,PSOFILL)
- ; Validate the claim.
- S VALID=$$VAL^BPSPSOU1(RXIEN,PSOFILL,PSOELIG,"RES",.PSOCOB,.REVREAS) ;DBIA #6248
- I 'VALID G END
- I $$RXDEL(RXIEN,PSOFILL) D D PAUSE^VALM1 G END
- . W !!,"The claim cannot be Resubmitted since it has been deleted in Pharmacy."
- ; Resubmit the claim to ECME
- D ECMESND^PSOBPSU1(RXIEN,PSOFILL,,"ED",,,"RESUBMIT FROM RX EDIT SCREEN","","","","","","","",$G(PSOCOB))
- I $$PTLBL^PSOREJP2(RXIEN,PSOFILL) S PSORX("PSOL",1)=RXIEN_"," ; Add Rx to Queue List
- D PAUSE^VALM1
- S VALMBCK="R"
- Q
- ;
- FILL(RXIEN,DFN,PSOFL) ;
- N CNT,DIR,FILL,FLDT,PSOELIG,PSOET,PSOSTR,REFILL,RELDT,RF,RXNUM,X,Y
- D FULL^VALM1
- I '$G(RXIEN)!'$G(DFN) Q ""
- ;
- S RXNUM=$P($G(^PSRX(RXIEN,0)),U)
- K PSOFL,PSOFLZ
- ; Get refill dates and release dates
- S REFILL=0 F S REFILL=$O(^PSRX(RXIEN,1,REFILL)) Q:'REFILL D
- . S FLDT=$P($G(^PSRX(RXIEN,1,REFILL,0)),U)\1
- . S RELDT=$P($G(^PSRX(RXIEN,1,REFILL,0)),U,18)\1
- . S PSOFLZ(REFILL)=FLDT_U_RELDT
- ; Get orignal RX fill date and release date
- S FLDT=$P($G(^PSRX(RXIEN,2)),U)\1
- S RELDT=$P($G(^PSRX(RXIEN,2)),U,13)\1
- S PSOFLZ(0)=FLDT_U_RELDT
- ; Check for any deleted fills that have ECME activity
- D RFL^BPSVRX(RXIEN,.PSOFL) ; DBIA #5723
- I '$D(PSOFL) Q "" ; Not in BPS transaction file.
- S RF="" F S RF=$O(PSOFL(RF)) Q:RF="" I '$D(PSOFLZ(RF)) S PSOFLZ(RF)=0_U_0
- ;
- S DIR(0)="S"
- S DIR("L",1)="Rx# "_RXNUM_" has the following fills:"
- S DIR("L",2)=""
- S DIR("L",3)=" Fill# Fill Date Release Date"
- S DIR("L",4)=" ----- ---------- ------------"
- S CNT=0,PSOSTR=""
- S RF="" F S RF=$O(PSOFLZ(RF)) Q:RF="" D
- . S CNT=CNT+1
- . S FLDT=$$FMTE^XLFDT($P(PSOFLZ(RF),U,1),"5Z") I 'FLDT S FLDT=" - "
- . S RELDT=$$FMTE^XLFDT($P(PSOFLZ(RF),U,2),"5Z") I 'RELDT S RELDT=" - "
- . I 'FLDT,'RELDT S (FLDT,RELDT)=" Deleted "
- . S $P(PSOSTR,";",CNT)=RF_":"_FLDT_" "_RELDT
- . S DIR("L",CNT+4)=$J(RF,7)_" "_FLDT_" "_RELDT
- . Q
- S DIR("L")=" "
- S $P(DIR(0),U,2)=PSOSTR
- S DIR("A")="Select Fill Number"
- S DIR("B")=$O(PSOFLZ(""),-1)
- I CNT=1 D
- . S $P(DIR("L",1)," ",$L(DIR("L",1)," "))="fill:" ; singular
- . Q
- W ! D ^DIR K DIR
- S FILL=Y
- Q FILL
- ;
- VER(RXIEN,DFN) ; -- VER hidden action under protocol PSO HIDDEN ACTIONS
- D FULL^VALM1
- K ^TMP("PSOHDR_ARCHIVE",$J)
- M ^TMP("PSOHDR_ARCHIVE",$J)=^TMP("PSOHDR",$J)
- S BPSVRX("RXIEN")=RXIEN
- D ^BPSVRX ;DBIA #5723
- M ^TMP("PSOHDR",$J)=^TMP("PSOHDR_ARCHIVE",$J)
- K ^TMP("PSOHDR_ARCHIVE",$J)
- S VALMBCK="R"
- Q
- ;
- REV(RXIEN,DFN) ; Reverse a claim action from PSO HIDDEN ACTIONS
- N DIRUT,PSOCOB,PSOFILL,PSOFL,PSOFLZ,PSOELIG,REVREAS,VALID
- S PSOFILL=$$FILL(RXIEN,DFN,.PSOFL)
- I $D(DIRUT) G END
- I PSOFILL="" W !!,"No claim was ever submitted for this prescription. Cannot reverse." D PAUSE^VALM1 G END
- S PSOELIG=$$ELIGDISP^PSOREJP1(RXIEN,PSOFILL)
- ; Validate the claim.
- S VALID=$$VAL^BPSPSOU1(RXIEN,PSOFILL,PSOELIG,"REV",.PSOCOB,.REVREAS) ;DBIA #6248
- I 'VALID G END
- I $$RXDEL(RXIEN,PSOFILL) D D PAUSE^VALM1 G END
- . W !!,"The claim cannot be Reversed since it has been deleted in Pharmacy."
- ; Submit the reversal to ECME
- D ECMESND^PSOBPSU1(RXIEN,PSOFILL,"","OREV","","",REVREAS,"","","","","","","",$G(PSOCOB))
- D PAUSE^VALM1
- S VALMBCK="R"
- Q
- ;
- RXDEL(RXIEN,PSOFILL) ; EP - $$ is RX deleted?
- ; For refills: if the refill multiple is gone, it's been "deleted"
- I $G(PSOFILL),'$P($G(^PSRX(RXIEN,1,PSOFILL,0)),U) Q 1
- ; For first fill: look at the STATUS flag
- I $P($G(^PSRX(RXIEN,0)),U,1)="" Q 1 ; shouldn't be missing but is
- N X S X=$P($G(^PSRX(RXIEN,"STA")),U,1)
- Q X=13 ; if status is DELETED
- ;
- END ;
- S VALMBCK="R"
- Q
- ;
- ECS(PSORX,PSOFILL,PSOSCREEN) ; Edit Claim to be Submitted.
- ;
- ; Input: PSORX = Prescription IEN, pointer to file #52, ^PSRX
- ; PSOFILL = Refill#. If not passed in, then the user
- ; will be prompted to select a fill.
- ; PSOSCREEN = 1 if coming from the Medication Profile
- ; Screen, 2 if coming from the Reject Info Screen
- ;
- ; This entry point is associated with the action ECS Edit Claim
- ; Submitted. The user is asked to select a date to be used as the
- ; date of service on the claim. The user is then able to select
- ; one or more NCPDP fields to be added to the claim. The claim is
- ; then resubmitted.
- ;
- N DIR,DIRUT,PSOADDLFLDS,PSOALTXT,PSOCLAIM,PSOCOB,PSODATESELECTED
- N PSODOS,PSOELIG,PSOIEN59,PSOQUIT,PSORESPONSE,PSOVALID,PSOVRIEN
- S PSOCOB=""
- S PSOQUIT=0
- ;
- I '$D(@(VALMAR)) G ECSQUIT
- D FULL^VALM1
- ;
- ; If Fill was not passed in, then prompt the user to select a fill.
- ; If the user exited out or there was not a fill with ECME activity,
- ; then exit out.
- ;
- I $G(PSOFILL)="" D I PSOQUIT=-1 G ECSQUIT
- . S PSOFILL=$$FILL(PSORX,DFN)
- . I $D(DIRUT) S PSOQUIT=-1 Q
- . I PSOFILL="" D
- . . W !!,"No claim was ever submitted for this prescription. Cannot resubmit."
- . . D PAUSE^VALM1
- . . S PSOQUIT=-1
- . . Q
- . Q
- ;
- ; Determine the Transaction IEN and Claim IEN.
- ;
- S PSOIEN59=$$CLAIM^BPSBUTL(PSORX,PSOFILL) ; ICR# 4719
- S PSOCLAIM=$P(PSOIEN59,U,2)
- S PSOIEN59=$P(PSOIEN59,U,1)
- I PSOIEN59=""!(PSOCLAIM="") D G ECSQUIT
- . W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Re-"
- . W !,"Submission"
- . D PAUSE^VALM1
- . Q
- ;
- ; Disallow resubmission if Fill or Rx has been deleted.
- ;
- I $$RXDEL(PSORX,PSOFILL) D G ECSQUIT
- . W !!,"The claim cannot be Resubmitted since it has been deleted in Pharmacy."
- . D PAUSE^VALM1
- . Q
- ;
- ; $$VAL^BPSPSOU1 performs several checks to determine whether the
- ; claim can be resubmitted.
- ;
- S PSOELIG=$$ELIGDISP^PSOREJP1(PSORX,PSOFILL)
- S PSOVALID=$$VAL^BPSPSOU1(PSORX,PSOFILL,PSOELIG,"RES",.PSOCOB,"",1) ; ICR# 6248
- I 'PSOVALID G ECSQUIT
- ;
- W !!,"Enter ^ at any prompt to exit"
- ;
- ; If there is an unresolved reject for this Rx/Fill, ask user to
- ; confirm that they wish to resolve the reject and resubmit a claim.
- ;
- S PSOQUIT=0
- I $$FIND^PSOREJUT(PSORX,PSOFILL) D I PSOQUIT'=1 G ECSQUIT
- . W !!," When you confirm, a new claim will be submitted for"
- . W !," the prescription and this REJECT will be marked"
- . W !," resolved."
- . S PSOQUIT=$$YESNO^PSOREJP3(" Confirm","YES")
- . Q
- ;
- ; Allow user to select a date to use as the Date of Service.
- ; PSODATESELECTED will be reset to 1 if the user is prompted to
- ; select a date within $$EDITDT and the user selected a date
- ; not equal to the Release Date; otherwise it will be left as 0.
- ;
- S PSOALTXT=""
- S PSODATESELECTED=0
- S PSODOS=$$EDITDT(PSORX,PSOFILL,PSOCOB,PSOCLAIM,PSOIEN59,.PSOALTXT,.PSODATESELECTED)
- I PSODOS="^" G ECSQUIT
- ;
- ; Allow user to add to the claim additional fields which are
- ; not on the payer sheet.
- ;
- S PSOQUIT=$$ADDLFLDS^BPSRES1(PSOCLAIM,PSOIEN59,.PSOADDLFLDS,$S(PSODATESELECTED:PSODOS,1:"")) ; IA 6938
- I PSOQUIT=-1 G ECSQUIT
- ;
- ; If the user did not add any additional NCPDP fields to the claim
- ; ('PSOQUIT), and the user did not select a data of service
- ; ('PSODATESELECTED), then display a message and Quit.
- ;
- I 'PSOQUIT,'PSODATESELECTED D G ECSQUIT
- . W !!,"No value changed. A claim will not be submitted.",!
- . N DIR
- . S DIR(0)="E"
- . S DIR("A")="Press enter to continue"
- . D ^DIR
- . Q
- ;
- ; Require the user to confirm they wish to continue.
- ;
- W !!,"A claim will be submitted now."
- S PSOQUIT=$$YESNO^PSOREJP3("Are you sure (Y/N)","Y")
- I PSOQUIT'=1 G ECSQUIT
- ;
- ; Save the list of additional fields in file# 9002313.511,
- ; BPS NCPDP OVERRIDES.
- ;
- I $D(PSOADDLFLDS) D I PSOQUIT=-1 G ECSQUIT
- . S PSOQUIT=$$SAVE^BPSRES1("ECS",PSOIEN59,.PSOADDLFLDS,.PSOVRIEN) ; IA 6938
- . Q
- ;
- ; Call ECMESND^PSOBPSU1 to reverse the existing claim and submit a new
- ; claim. The additional fields indicated by the user will be added to
- ; the claim in XLOOP^BPSOSCF and XLOOP^BPSOSH2.
- ;
- D ECMESND^PSOBPSU1(PSORX,PSOFILL,PSODOS,"ED","","","RX EDITED","","",.PSORESPONSE,"",PSOALTXT,"","",PSOCOB,$G(PSOVRIEN(1)))
- ;
- ; If the claim submission was unsuccessful, then PSORESPONSE will
- ; not be blank. Display the reason it failed, then quit out.
- ;
- I $G(PSORESPONSE) D G ECSQUIT
- . W !!?10,"Claim could not be submitted. Please try again later!"
- . W !,?10,"Reason: ",$S($P(PSORESPONSE,"^",2)="":"UNKNOWN",1:$P(PSORESPONSE,"^",2)),$C(7)
- . D PAUSE^VALM1
- . Q
- ;
- ; Conditionally prompt the user "Print Label?". If user wishes to
- ; print a label, then either put the Rx on queue to be printed when
- ; the user leaves the screen (if on Medication Profile Screen) or
- ; print the label now (if on the Reject Info Screen).
- ;
- I $$PTLBL^PSOREJP2(PSORX,PSOFILL) D
- . I PSOSCREEN=1 S PSORX("PSOL",1)=PSORX_","
- . I PSOSCREEN=2 D PRINT^PSOREJP3(PSORX,PSOFILL)
- . Q
- ;
- ; If on the Reject Info Screen, then if the Status Filter
- ; (PSOSTFLT) is not "B"oth, set the CHANGE flag to 1, which
- ; will cause the screen to be rebuilt.
- ;
- I PSOSCREEN=2,$D(PSOSTFLT),PSOSTFLT'="B" S CHANGE=1
- ;
- D PAUSE^VALM1
- ;
- ECSQUIT ;
- ;
- S VALMBCK="R"
- ;
- Q
- ;
- EDITDT(PSORX,PSOFILL,PSOCOB,PSOCLAIM,PSOIEN59,PSOALTXT,PSODATESELECTED) ; Allow user to select Date of Service.
- ;
- ; Input: PSORX = Prescription IEN, pointer to file# 52, ^PSRX
- ; PSOFILL = Refill#. If not passed in, then the user
- ; PSOCOB = COB (1=Primary, etc.)
- ; PSOCLAIM = Claim IEN, pointer to file# 9002313.02, ^BPSC
- ; PSOIEN59 = Transaction IEN, pointer to file# 9002313.59
- ;
- ; Output: Selected Date of Service, in FileMan format
- ; PSOALTXT = Passed by reference; populate if user
- ; selects the Release Date
- ; PSODATESELECTED = Passed by reference; set to '1' if
- ; the user selected a date different from the Release
- ; Date.
- ;
- N DIR,DIRUT,DIROUT,DTOUT,DUOUT
- N PSOCLAIM2,PSODATE,PSODATEARRAY,PSODESC,PSOFILLDT
- N PSOIEN57,PSORELEASEDT,PSOTEMP,X,Y
- ;
- ; Determine the Release Date, the Fill Date, and all Dates of Service.
- ; In order to present the entire list to the user in chronological
- ; order, they will be put into an array.
- ;
- S PSORELEASEDT=$$RXRLDT^PSOBPSUT(PSORX,PSOFILL)\1
- I +PSORELEASEDT=0 D Q DT
- . S X=$$FMTE^XLFDT(DT,"5D")
- . W !!,"Rx is not released. Date of Service will be ",X,"."
- . S PSOALTXT="Date of Service ("_X_")"
- . Q
- S PSODATEARRAY(PSORELEASEDT,3)="Release Date"
- S PSOFILLDT=$$RXFLDT^PSOBPSUT(PSORX,PSOFILL)\1
- I PSOFILLDT'="" S PSODATEARRAY(PSOFILLDT,1)="Fill Date"
- ;
- ; Add to the array each Date of Service from all previous Claims,
- ; which are identified by looping through all entries in the BPS Log
- ; of Transactions file for the current BPS Transaction and pulling
- ; the Claim for each entry and the Date of Service for that Claim.
- ;
- S PSOIEN57=0
- F S PSOIEN57=$O(^BPSTL("B",PSOIEN59,PSOIEN57)) Q:'PSOIEN57 D
- . S PSOCLAIM2=$$GET1^DIQ(9002313.57,PSOIEN57,3,"I")
- . S PSODATE=$$HL7TFM^XLFDT($$GET1^DIQ(9002313.02,PSOCLAIM2,401))
- . I PSODATE'="" S PSODATEARRAY(PSODATE,2)="Date of Service"
- . Q
- ;
- ; If the dates are all the same, then the user is not
- ; allowed to select a date.
- ;
- S PSODATE=$O(PSODATEARRAY(""))
- I $O(PSODATEARRAY(PSODATE))="" D Q PSODATE
- . W !
- . S X=0
- . F S X=$O(PSODATEARRAY(PSODATE,X)) Q:'X D
- . . W !,?10,$$FMTE^XLFDT(PSODATE,"5D")," ",PSODATEARRAY(PSODATE,X)
- . . Q
- . W !!,"Claim will be submitted with ",$$FMTE^XLFDT(PSODATE,"5D")," Date of Service."
- . S PSOALTXT="Date of Service ("_$$FMTE^XLFDT(PSODATE,"5D")_")"
- . Q
- ;
- S DIR("?",1)=" Enter a date of service to override the date algorithm."
- S DIR("?")=" The date algorithm will use the release date as a default value."
- S DIR("A")="Date of Service"
- S DIR("B")=1
- S DIR(0)="S^"
- S Y=0
- S PSODATE=0
- F S PSODATE=$O(PSODATEARRAY(PSODATE)) Q:'PSODATE D
- . S X=0
- . F S X=$O(PSODATEARRAY(PSODATE,X)) Q:'X D
- . . S Y=Y+1
- . . S PSOTEMP(Y)=PSODATE
- . . S PSODESC=PSODATEARRAY(PSODATE,X)
- . . S DIR(0)=DIR(0)_Y_":"_$$FMTE^XLFDT(PSODATE,"5D")_" "_PSODESC_";"
- . . I PSODESC="Release Date" S DIR("B")=Y
- . . Q
- . Q
- ;
- D ^DIR
- I $D(DIRUT) Q "^"
- ;
- ; If we get here, the user selected a date. Set the PSODATESELECTED
- ; flag to 1 if the user selected a date other than the Release Date
- ; and set PSOALTXT, which will eventually be put on the Activity Log.
- ;
- I Y'=DIR("B") S PSODATESELECTED=1
- S PSOALTXT="Date of Service ("_$$FMTE^XLFDT(PSOTEMP(Y),"5D")_")"
- ;
- Q PSOTEMP(Y)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOBPSU3 13160 printed Jan 18, 2025@03:26:13 Page 2
- PSOBPSU3 ;ALB/CFS - BPS (ECME) Utilities 3 ;08/27/15
- +1 ;;7.0;OUTPATIENT PHARMACY;**448,482,512**;DEC 1997;Build 44
- +2 ; Reference to ^BPSVRX supported by IA #5723
- +3 ; Reference to ^BPSPSOU1 supported by IA #6248
- +4 ; Reference to $$ADDLFLDS^BPSRES1 supported by IA #6938
- +5 ; Reference to $$SAVE^BPSRES1 supported by IA #6938
- +6 ;
- RES(RXIEN,DFN) ; Resubmit a claim action from PSO HIDDEN ACTIONS
- +1 NEW ACTION,DIRUT,PSOCOB,PSOFILL,PSOFL,PSOFLZ,PSOELIG,REVREAS,VALID
- +2 SET PSOFILL=$$FILL(RXIEN,DFN,.PSOFL)
- +3 IF $DATA(DIRUT)
- GOTO END
- +4 IF PSOFILL=""
- WRITE !!,"No claim was ever submitted for this prescription. Cannot resubmit."
- DO PAUSE^VALM1
- GOTO END
- +5 SET PSOELIG=$$ELIGDISP^PSOREJP1(RXIEN,PSOFILL)
- +6 ; Validate the claim.
- +7 ;DBIA #6248
- SET VALID=$$VAL^BPSPSOU1(RXIEN,PSOFILL,PSOELIG,"RES",.PSOCOB,.REVREAS)
- +8 IF 'VALID
- GOTO END
- +9 IF $$RXDEL(RXIEN,PSOFILL)
- Begin DoDot:1
- +10 WRITE !!,"The claim cannot be Resubmitted since it has been deleted in Pharmacy."
- End DoDot:1
- DO PAUSE^VALM1
- GOTO END
- +11 ; Resubmit the claim to ECME
- +12 DO ECMESND^PSOBPSU1(RXIEN,PSOFILL,,"ED",,,"RESUBMIT FROM RX EDIT SCREEN","","","","","","","",$GET(PSOCOB))
- +13 ; Add Rx to Queue List
- IF $$PTLBL^PSOREJP2(RXIEN,PSOFILL)
- SET PSORX("PSOL",1)=RXIEN_","
- +14 DO PAUSE^VALM1
- +15 SET VALMBCK="R"
- +16 QUIT
- +17 ;
- FILL(RXIEN,DFN,PSOFL) ;
- +1 NEW CNT,DIR,FILL,FLDT,PSOELIG,PSOET,PSOSTR,REFILL,RELDT,RF,RXNUM,X,Y
- +2 DO FULL^VALM1
- +3 IF '$GET(RXIEN)!'$GET(DFN)
- QUIT ""
- +4 ;
- +5 SET RXNUM=$PIECE($GET(^PSRX(RXIEN,0)),U)
- +6 KILL PSOFL,PSOFLZ
- +7 ; Get refill dates and release dates
- +8 SET REFILL=0
- FOR
- SET REFILL=$ORDER(^PSRX(RXIEN,1,REFILL))
- if 'REFILL
- QUIT
- Begin DoDot:1
- +9 SET FLDT=$PIECE($GET(^PSRX(RXIEN,1,REFILL,0)),U)\1
- +10 SET RELDT=$PIECE($GET(^PSRX(RXIEN,1,REFILL,0)),U,18)\1
- +11 SET PSOFLZ(REFILL)=FLDT_U_RELDT
- End DoDot:1
- +12 ; Get orignal RX fill date and release date
- +13 SET FLDT=$PIECE($GET(^PSRX(RXIEN,2)),U)\1
- +14 SET RELDT=$PIECE($GET(^PSRX(RXIEN,2)),U,13)\1
- +15 SET PSOFLZ(0)=FLDT_U_RELDT
- +16 ; Check for any deleted fills that have ECME activity
- +17 ; DBIA #5723
- DO RFL^BPSVRX(RXIEN,.PSOFL)
- +18 ; Not in BPS transaction file.
- IF '$DATA(PSOFL)
- QUIT ""
- +19 SET RF=""
- FOR
- SET RF=$ORDER(PSOFL(RF))
- if RF=""
- QUIT
- IF '$DATA(PSOFLZ(RF))
- SET PSOFLZ(RF)=0_U_0
- +20 ;
- +21 SET DIR(0)="S"
- +22 SET DIR("L",1)="Rx# "_RXNUM_" has the following fills:"
- +23 SET DIR("L",2)=""
- +24 SET DIR("L",3)=" Fill# Fill Date Release Date"
- +25 SET DIR("L",4)=" ----- ---------- ------------"
- +26 SET CNT=0
- SET PSOSTR=""
- +27 SET RF=""
- FOR
- SET RF=$ORDER(PSOFLZ(RF))
- if RF=""
- QUIT
- Begin DoDot:1
- +28 SET CNT=CNT+1
- +29 SET FLDT=$$FMTE^XLFDT($PIECE(PSOFLZ(RF),U,1),"5Z")
- IF 'FLDT
- SET FLDT=" - "
- +30 SET RELDT=$$FMTE^XLFDT($PIECE(PSOFLZ(RF),U,2),"5Z")
- IF 'RELDT
- SET RELDT=" - "
- +31 IF 'FLDT
- IF 'RELDT
- SET (FLDT,RELDT)=" Deleted "
- +32 SET $PIECE(PSOSTR,";",CNT)=RF_":"_FLDT_" "_RELDT
- +33 SET DIR("L",CNT+4)=$JUSTIFY(RF,7)_" "_FLDT_" "_RELDT
- +34 QUIT
- End DoDot:1
- +35 SET DIR("L")=" "
- +36 SET $PIECE(DIR(0),U,2)=PSOSTR
- +37 SET DIR("A")="Select Fill Number"
- +38 SET DIR("B")=$ORDER(PSOFLZ(""),-1)
- +39 IF CNT=1
- Begin DoDot:1
- +40 ; singular
- SET $PIECE(DIR("L",1)," ",$LENGTH(DIR("L",1)," "))="fill:"
- +41 QUIT
- End DoDot:1
- +42 WRITE !
- DO ^DIR
- KILL DIR
- +43 SET FILL=Y
- +44 QUIT FILL
- +45 ;
- VER(RXIEN,DFN) ; -- VER hidden action under protocol PSO HIDDEN ACTIONS
- +1 DO FULL^VALM1
- +2 KILL ^TMP("PSOHDR_ARCHIVE",$JOB)
- +3 MERGE ^TMP("PSOHDR_ARCHIVE",$JOB)=^TMP("PSOHDR",$JOB)
- +4 SET BPSVRX("RXIEN")=RXIEN
- +5 ;DBIA #5723
- DO ^BPSVRX
- +6 MERGE ^TMP("PSOHDR",$JOB)=^TMP("PSOHDR_ARCHIVE",$JOB)
- +7 KILL ^TMP("PSOHDR_ARCHIVE",$JOB)
- +8 SET VALMBCK="R"
- +9 QUIT
- +10 ;
- REV(RXIEN,DFN) ; Reverse a claim action from PSO HIDDEN ACTIONS
- +1 NEW DIRUT,PSOCOB,PSOFILL,PSOFL,PSOFLZ,PSOELIG,REVREAS,VALID
- +2 SET PSOFILL=$$FILL(RXIEN,DFN,.PSOFL)
- +3 IF $DATA(DIRUT)
- GOTO END
- +4 IF PSOFILL=""
- WRITE !!,"No claim was ever submitted for this prescription. Cannot reverse."
- DO PAUSE^VALM1
- GOTO END
- +5 SET PSOELIG=$$ELIGDISP^PSOREJP1(RXIEN,PSOFILL)
- +6 ; Validate the claim.
- +7 ;DBIA #6248
- SET VALID=$$VAL^BPSPSOU1(RXIEN,PSOFILL,PSOELIG,"REV",.PSOCOB,.REVREAS)
- +8 IF 'VALID
- GOTO END
- +9 IF $$RXDEL(RXIEN,PSOFILL)
- Begin DoDot:1
- +10 WRITE !!,"The claim cannot be Reversed since it has been deleted in Pharmacy."
- End DoDot:1
- DO PAUSE^VALM1
- GOTO END
- +11 ; Submit the reversal to ECME
- +12 DO ECMESND^PSOBPSU1(RXIEN,PSOFILL,"","OREV","","",REVREAS,"","","","","","","",$GET(PSOCOB))
- +13 DO PAUSE^VALM1
- +14 SET VALMBCK="R"
- +15 QUIT
- +16 ;
- RXDEL(RXIEN,PSOFILL) ; EP - $$ is RX deleted?
- +1 ; For refills: if the refill multiple is gone, it's been "deleted"
- +2 IF $GET(PSOFILL)
- IF '$PIECE($GET(^PSRX(RXIEN,1,PSOFILL,0)),U)
- QUIT 1
- +3 ; For first fill: look at the STATUS flag
- +4 ; shouldn't be missing but is
- IF $PIECE($GET(^PSRX(RXIEN,0)),U,1)=""
- QUIT 1
- +5 NEW X
- SET X=$PIECE($GET(^PSRX(RXIEN,"STA")),U,1)
- +6 ; if status is DELETED
- QUIT X=13
- +7 ;
- END ;
- +1 SET VALMBCK="R"
- +2 QUIT
- +3 ;
- ECS(PSORX,PSOFILL,PSOSCREEN) ; Edit Claim to be Submitted.
- +1 ;
- +2 ; Input: PSORX = Prescription IEN, pointer to file #52, ^PSRX
- +3 ; PSOFILL = Refill#. If not passed in, then the user
- +4 ; will be prompted to select a fill.
- +5 ; PSOSCREEN = 1 if coming from the Medication Profile
- +6 ; Screen, 2 if coming from the Reject Info Screen
- +7 ;
- +8 ; This entry point is associated with the action ECS Edit Claim
- +9 ; Submitted. The user is asked to select a date to be used as the
- +10 ; date of service on the claim. The user is then able to select
- +11 ; one or more NCPDP fields to be added to the claim. The claim is
- +12 ; then resubmitted.
- +13 ;
- +14 NEW DIR,DIRUT,PSOADDLFLDS,PSOALTXT,PSOCLAIM,PSOCOB,PSODATESELECTED
- +15 NEW PSODOS,PSOELIG,PSOIEN59,PSOQUIT,PSORESPONSE,PSOVALID,PSOVRIEN
- +16 SET PSOCOB=""
- +17 SET PSOQUIT=0
- +18 ;
- +19 IF '$DATA(@(VALMAR))
- GOTO ECSQUIT
- +20 DO FULL^VALM1
- +21 ;
- +22 ; If Fill was not passed in, then prompt the user to select a fill.
- +23 ; If the user exited out or there was not a fill with ECME activity,
- +24 ; then exit out.
- +25 ;
- +26 IF $GET(PSOFILL)=""
- Begin DoDot:1
- +27 SET PSOFILL=$$FILL(PSORX,DFN)
- +28 IF $DATA(DIRUT)
- SET PSOQUIT=-1
- QUIT
- +29 IF PSOFILL=""
- Begin DoDot:2
- +30 WRITE !!,"No claim was ever submitted for this prescription. Cannot resubmit."
- +31 DO PAUSE^VALM1
- +32 SET PSOQUIT=-1
- +33 QUIT
- End DoDot:2
- +34 QUIT
- End DoDot:1
- IF PSOQUIT=-1
- GOTO ECSQUIT
- +35 ;
- +36 ; Determine the Transaction IEN and Claim IEN.
- +37 ;
- +38 ; ICR# 4719
- SET PSOIEN59=$$CLAIM^BPSBUTL(PSORX,PSOFILL)
- +39 SET PSOCLAIM=$PIECE(PSOIEN59,U,2)
- +40 SET PSOIEN59=$PIECE(PSOIEN59,U,1)
- +41 IF PSOIEN59=""!(PSOCLAIM="")
- Begin DoDot:1
- +42 WRITE !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Re-"
- +43 WRITE !,"Submission"
- +44 DO PAUSE^VALM1
- +45 QUIT
- End DoDot:1
- GOTO ECSQUIT
- +46 ;
- +47 ; Disallow resubmission if Fill or Rx has been deleted.
- +48 ;
- +49 IF $$RXDEL(PSORX,PSOFILL)
- Begin DoDot:1
- +50 WRITE !!,"The claim cannot be Resubmitted since it has been deleted in Pharmacy."
- +51 DO PAUSE^VALM1
- +52 QUIT
- End DoDot:1
- GOTO ECSQUIT
- +53 ;
- +54 ; $$VAL^BPSPSOU1 performs several checks to determine whether the
- +55 ; claim can be resubmitted.
- +56 ;
- +57 SET PSOELIG=$$ELIGDISP^PSOREJP1(PSORX,PSOFILL)
- +58 ; ICR# 6248
- SET PSOVALID=$$VAL^BPSPSOU1(PSORX,PSOFILL,PSOELIG,"RES",.PSOCOB,"",1)
- +59 IF 'PSOVALID
- GOTO ECSQUIT
- +60 ;
- +61 WRITE !!,"Enter ^ at any prompt to exit"
- +62 ;
- +63 ; If there is an unresolved reject for this Rx/Fill, ask user to
- +64 ; confirm that they wish to resolve the reject and resubmit a claim.
- +65 ;
- +66 SET PSOQUIT=0
- +67 IF $$FIND^PSOREJUT(PSORX,PSOFILL)
- Begin DoDot:1
- +68 WRITE !!," When you confirm, a new claim will be submitted for"
- +69 WRITE !," the prescription and this REJECT will be marked"
- +70 WRITE !," resolved."
- +71 SET PSOQUIT=$$YESNO^PSOREJP3(" Confirm","YES")
- +72 QUIT
- End DoDot:1
- IF PSOQUIT'=1
- GOTO ECSQUIT
- +73 ;
- +74 ; Allow user to select a date to use as the Date of Service.
- +75 ; PSODATESELECTED will be reset to 1 if the user is prompted to
- +76 ; select a date within $$EDITDT and the user selected a date
- +77 ; not equal to the Release Date; otherwise it will be left as 0.
- +78 ;
- +79 SET PSOALTXT=""
- +80 SET PSODATESELECTED=0
- +81 SET PSODOS=$$EDITDT(PSORX,PSOFILL,PSOCOB,PSOCLAIM,PSOIEN59,.PSOALTXT,.PSODATESELECTED)
- +82 IF PSODOS="^"
- GOTO ECSQUIT
- +83 ;
- +84 ; Allow user to add to the claim additional fields which are
- +85 ; not on the payer sheet.
- +86 ;
- +87 ; IA 6938
- SET PSOQUIT=$$ADDLFLDS^BPSRES1(PSOCLAIM,PSOIEN59,.PSOADDLFLDS,$SELECT(PSODATESELECTED:PSODOS,1:""))
- +88 IF PSOQUIT=-1
- GOTO ECSQUIT
- +89 ;
- +90 ; If the user did not add any additional NCPDP fields to the claim
- +91 ; ('PSOQUIT), and the user did not select a data of service
- +92 ; ('PSODATESELECTED), then display a message and Quit.
- +93 ;
- +94 IF 'PSOQUIT
- IF 'PSODATESELECTED
- Begin DoDot:1
- +95 WRITE !!,"No value changed. A claim will not be submitted.",!
- +96 NEW DIR
- +97 SET DIR(0)="E"
- +98 SET DIR("A")="Press enter to continue"
- +99 DO ^DIR
- +100 QUIT
- End DoDot:1
- GOTO ECSQUIT
- +101 ;
- +102 ; Require the user to confirm they wish to continue.
- +103 ;
- +104 WRITE !!,"A claim will be submitted now."
- +105 SET PSOQUIT=$$YESNO^PSOREJP3("Are you sure (Y/N)","Y")
- +106 IF PSOQUIT'=1
- GOTO ECSQUIT
- +107 ;
- +108 ; Save the list of additional fields in file# 9002313.511,
- +109 ; BPS NCPDP OVERRIDES.
- +110 ;
- +111 IF $DATA(PSOADDLFLDS)
- Begin DoDot:1
- +112 ; IA 6938
- SET PSOQUIT=$$SAVE^BPSRES1("ECS",PSOIEN59,.PSOADDLFLDS,.PSOVRIEN)
- +113 QUIT
- End DoDot:1
- IF PSOQUIT=-1
- GOTO ECSQUIT
- +114 ;
- +115 ; Call ECMESND^PSOBPSU1 to reverse the existing claim and submit a new
- +116 ; claim. The additional fields indicated by the user will be added to
- +117 ; the claim in XLOOP^BPSOSCF and XLOOP^BPSOSH2.
- +118 ;
- +119 DO ECMESND^PSOBPSU1(PSORX,PSOFILL,PSODOS,"ED","","","RX EDITED","","",.PSORESPONSE,"",PSOALTXT,"","",PSOCOB,$GET(PSOVRIEN(1)))
- +120 ;
- +121 ; If the claim submission was unsuccessful, then PSORESPONSE will
- +122 ; not be blank. Display the reason it failed, then quit out.
- +123 ;
- +124 IF $GET(PSORESPONSE)
- Begin DoDot:1
- +125 WRITE !!?10,"Claim could not be submitted. Please try again later!"
- +126 WRITE !,?10,"Reason: ",$SELECT($PIECE(PSORESPONSE,"^",2)="":"UNKNOWN",1:$PIECE(PSORESPONSE,"^",2)),$CHAR(7)
- +127 DO PAUSE^VALM1
- +128 QUIT
- End DoDot:1
- GOTO ECSQUIT
- +129 ;
- +130 ; Conditionally prompt the user "Print Label?". If user wishes to
- +131 ; print a label, then either put the Rx on queue to be printed when
- +132 ; the user leaves the screen (if on Medication Profile Screen) or
- +133 ; print the label now (if on the Reject Info Screen).
- +134 ;
- +135 IF $$PTLBL^PSOREJP2(PSORX,PSOFILL)
- Begin DoDot:1
- +136 IF PSOSCREEN=1
- SET PSORX("PSOL",1)=PSORX_","
- +137 IF PSOSCREEN=2
- DO PRINT^PSOREJP3(PSORX,PSOFILL)
- +138 QUIT
- End DoDot:1
- +139 ;
- +140 ; If on the Reject Info Screen, then if the Status Filter
- +141 ; (PSOSTFLT) is not "B"oth, set the CHANGE flag to 1, which
- +142 ; will cause the screen to be rebuilt.
- +143 ;
- +144 IF PSOSCREEN=2
- IF $DATA(PSOSTFLT)
- IF PSOSTFLT'="B"
- SET CHANGE=1
- +145 ;
- +146 DO PAUSE^VALM1
- +147 ;
- ECSQUIT ;
- +1 ;
- +2 SET VALMBCK="R"
- +3 ;
- +4 QUIT
- +5 ;
- EDITDT(PSORX,PSOFILL,PSOCOB,PSOCLAIM,PSOIEN59,PSOALTXT,PSODATESELECTED) ; Allow user to select Date of Service.
- +1 ;
- +2 ; Input: PSORX = Prescription IEN, pointer to file# 52, ^PSRX
- +3 ; PSOFILL = Refill#. If not passed in, then the user
- +4 ; PSOCOB = COB (1=Primary, etc.)
- +5 ; PSOCLAIM = Claim IEN, pointer to file# 9002313.02, ^BPSC
- +6 ; PSOIEN59 = Transaction IEN, pointer to file# 9002313.59
- +7 ;
- +8 ; Output: Selected Date of Service, in FileMan format
- +9 ; PSOALTXT = Passed by reference; populate if user
- +10 ; selects the Release Date
- +11 ; PSODATESELECTED = Passed by reference; set to '1' if
- +12 ; the user selected a date different from the Release
- +13 ; Date.
- +14 ;
- +15 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT
- +16 NEW PSOCLAIM2,PSODATE,PSODATEARRAY,PSODESC,PSOFILLDT
- +17 NEW PSOIEN57,PSORELEASEDT,PSOTEMP,X,Y
- +18 ;
- +19 ; Determine the Release Date, the Fill Date, and all Dates of Service.
- +20 ; In order to present the entire list to the user in chronological
- +21 ; order, they will be put into an array.
- +22 ;
- +23 SET PSORELEASEDT=$$RXRLDT^PSOBPSUT(PSORX,PSOFILL)\1
- +24 IF +PSORELEASEDT=0
- Begin DoDot:1
- +25 SET X=$$FMTE^XLFDT(DT,"5D")
- +26 WRITE !!,"Rx is not released. Date of Service will be ",X,"."
- +27 SET PSOALTXT="Date of Service ("_X_")"
- +28 QUIT
- End DoDot:1
- QUIT DT
- +29 SET PSODATEARRAY(PSORELEASEDT,3)="Release Date"
- +30 SET PSOFILLDT=$$RXFLDT^PSOBPSUT(PSORX,PSOFILL)\1
- +31 IF PSOFILLDT'=""
- SET PSODATEARRAY(PSOFILLDT,1)="Fill Date"
- +32 ;
- +33 ; Add to the array each Date of Service from all previous Claims,
- +34 ; which are identified by looping through all entries in the BPS Log
- +35 ; of Transactions file for the current BPS Transaction and pulling
- +36 ; the Claim for each entry and the Date of Service for that Claim.
- +37 ;
- +38 SET PSOIEN57=0
- +39 FOR
- SET PSOIEN57=$ORDER(^BPSTL("B",PSOIEN59,PSOIEN57))
- if 'PSOIEN57
- QUIT
- Begin DoDot:1
- +40 SET PSOCLAIM2=$$GET1^DIQ(9002313.57,PSOIEN57,3,"I")
- +41 SET PSODATE=$$HL7TFM^XLFDT($$GET1^DIQ(9002313.02,PSOCLAIM2,401))
- +42 IF PSODATE'=""
- SET PSODATEARRAY(PSODATE,2)="Date of Service"
- +43 QUIT
- End DoDot:1
- +44 ;
- +45 ; If the dates are all the same, then the user is not
- +46 ; allowed to select a date.
- +47 ;
- +48 SET PSODATE=$ORDER(PSODATEARRAY(""))
- +49 IF $ORDER(PSODATEARRAY(PSODATE))=""
- Begin DoDot:1
- +50 WRITE !
- +51 SET X=0
- +52 FOR
- SET X=$ORDER(PSODATEARRAY(PSODATE,X))
- if 'X
- QUIT
- Begin DoDot:2
- +53 WRITE !,?10,$$FMTE^XLFDT(PSODATE,"5D")," ",PSODATEARRAY(PSODATE,X)
- +54 QUIT
- End DoDot:2
- +55 WRITE !!,"Claim will be submitted with ",$$FMTE^XLFDT(PSODATE,"5D")," Date of Service."
- +56 SET PSOALTXT="Date of Service ("_$$FMTE^XLFDT(PSODATE,"5D")_")"
- +57 QUIT
- End DoDot:1
- QUIT PSODATE
- +58 ;
- +59 SET DIR("?",1)=" Enter a date of service to override the date algorithm."
- +60 SET DIR("?")=" The date algorithm will use the release date as a default value."
- +61 SET DIR("A")="Date of Service"
- +62 SET DIR("B")=1
- +63 SET DIR(0)="S^"
- +64 SET Y=0
- +65 SET PSODATE=0
- +66 FOR
- SET PSODATE=$ORDER(PSODATEARRAY(PSODATE))
- if 'PSODATE
- QUIT
- Begin DoDot:1
- +67 SET X=0
- +68 FOR
- SET X=$ORDER(PSODATEARRAY(PSODATE,X))
- if 'X
- QUIT
- Begin DoDot:2
- +69 SET Y=Y+1
- +70 SET PSOTEMP(Y)=PSODATE
- +71 SET PSODESC=PSODATEARRAY(PSODATE,X)
- +72 SET DIR(0)=DIR(0)_Y_":"_$$FMTE^XLFDT(PSODATE,"5D")_" "_PSODESC_";"
- +73 IF PSODESC="Release Date"
- SET DIR("B")=Y
- +74 QUIT
- End DoDot:2
- +75 QUIT
- End DoDot:1
- +76 ;
- +77 DO ^DIR
- +78 IF $DATA(DIRUT)
- QUIT "^"
- +79 ;
- +80 ; If we get here, the user selected a date. Set the PSODATESELECTED
- +81 ; flag to 1 if the user selected a date other than the Release Date
- +82 ; and set PSOALTXT, which will eventually be put on the Activity Log.
- +83 ;
- +84 IF Y'=DIR("B")
- SET PSODATESELECTED=1
- +85 SET PSOALTXT="Date of Service ("_$$FMTE^XLFDT(PSOTEMP(Y),"5D")_")"
- +86 ;
- +87 QUIT PSOTEMP(Y)
- +88 ;