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

BPSELG.m

Go to the documentation of this file.
  1. BPSELG ;ALB/DRF - ECME SCREEN ELIGIBILITY VERIFICATION SUBMIT ;8/13/10 21:14
  1. ;;1.0;E CLAIMS MGMT ENGINE;**10,11**;JUN 2004;Build 27
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; reference to ^DIR supported by DBIA 10026
  1. ; references to FULL^VALM1 and PAUSE^VALM1 supported by DBIA 10016
  1. ; reference to $$FMTE^XLFDT supported by DBIA 10103
  1. ;
  1. ;ECME Eligibility Verification w/EDITS Protocol (Hidden) - Called by [BPS USER SCREEN]
  1. ;
  1. RESED N BPSEL
  1. ;
  1. I '$D(@(VALMAR)) G XRESED
  1. D FULL^VALM1
  1. ;
  1. ;Select the claim to submit
  1. W !,"Enter the line number for the claim to be submitted for Eligibility Verification"
  1. S BPSEL=$$ASKLINE("Select item","Please select a SINGLE claim only when using the Eligibility action option.")
  1. I BPSEL<1 S VALMBCK="R" G XRESED
  1. ;
  1. ;Attempt to submit the claim for eligibility
  1. D DOSELCTD(BPSEL)
  1. S VALMBCK="R"
  1. ;
  1. XRESED Q
  1. ;
  1. ;Attempt to Edit and Submit Selected Claim for Eligibility
  1. ;
  1. ; Input Value -> BPRXI - Entry with ptr to BPS TRANSACTION file
  1. ;
  1. ; Return Value -> 0 - Claim was not submitted
  1. ; 1 - Claim was submitted
  1. ;
  1. DOSELCTD(BPRXI) ;
  1. N BP02,BP59,BPRSLT,BPCLTOT,BPDFN,BPDOSDT,BPOVRIEN,BPQ,BPRXIEN,BPRXR,BPSTATUS,BPSELG,BPPROMPT,BPPSNCD,BPRELCD,BPUPDFLG
  1. S (BPQ)=""
  1. S (BPCLTOT,BPUPDFLG,BPRSLT)=0
  1. ;
  1. ;Pull BPS TRANSACTION/BPS CLAIMS entries
  1. S BP59=$P(BPRXI,U,4) I BP59="" W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",! G XRES
  1. S BP02=+$P($G(^BPST(BP59,0)),U,4) I 'BP02 W !!,"No Initial Claim Submission Found - Data Elements are NOT Editable for Eligibility Submission",! G XRES
  1. ;
  1. ;Write Form Feed
  1. W @IOF
  1. ;
  1. ;Display selected claim and ask to submit
  1. S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
  1. W !,"You've chosen to VERIFY Eligibility of the following prescription for "_$E($$PATNAME^BPSSCRU2(BPDFN),1,13)
  1. W !,@VALMAR@(+$P(BPRXI,U,5),0)
  1. S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
  1. I BPQ'=1 S BPQ="^" G XRES
  1. ;
  1. ;Check to make sure claim can be Submitted for Eligibility
  1. S BPRXIEN=$P(BP59,".")
  1. S BPRXR=+$E($P(BP59,".",2),1,4)
  1. S BPSTATUS=$P($$CLAIMST^BPSSCRU3(BP59),U)
  1. I BPSTATUS'["E REJECTED" W !!,"The claim: ",!,@VALMAR@(+$P(BPRXI,U,5),0),!,"is NOT Rejected and cannot be Submitted for Eligibility Verification",! G XRES
  1. ;
  1. ;Prompt for EDIT Information
  1. S BPPROMPT=$$PROMPTS(BP02,.BPDOSDT,.BPRELCD,.BPPSNCD) I BPPROMPT=-1 G XRES
  1. ;
  1. ;Send eligibility verification
  1. S BPSELG("PLAN")=$P($G(^BPST(BP59,10,1,0)),U,1) ;IEN to the GROUP INSURANCE PLAN (#355.3) file
  1. S BPSELG("DOS")=BPDOSDT ;Date of Service entered by the user
  1. S BPSELG("IEN")=+$P($G(^BPST(BP59,1)),U,11) ;Prescription, if available
  1. S BPSELG("FILL NUMBER")=+$P($G(^BPST(BP59,1)),U,1) ;Fill Number, if available
  1. S BPSELG("REL CODE")=BPRELCD
  1. S BPSELG("PERSON CODE")=BPPSNCD
  1. S BPRSLT=$$EN^BPSNCPD9(BPDFN,.BPSELG)
  1. ;
  1. ;Print Return Value Message
  1. W !!
  1. W $P(BPRSLT,U,2)
  1. ;
  1. XRES ;
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. ; Input Values -> BP02 - The BPS CLAIMS entry
  1. ;
  1. ; Output Value -> BPQ - -1 - The user chose to quit
  1. ; "" - The user completed the EDITS
  1. ; BPDOSDT - Effective Date of Eligibility Verification transaction
  1. ; BPRELCD - Patient Relationship Code from file #9002313.19
  1. ; BPPSNCD - Person Code assigned by payer. 1 - 3 characters free text
  1. ;
  1. PROMPTS(BP02,BPDOSDT,BPRELCD,BPPSNCD) ;
  1. I '$G(BP02) S BPQ=-1 G XPROMPTS
  1. N %,BP300,BPFDA,BPFLD,BPMED,BPMSG,BPQ,DIC,DIR,DIROUT,DTOUT,DUOUT,X,Y,DIRUT
  1. S BPQ=""
  1. ;
  1. ;Pull Information from Claim
  1. S BP300=$G(^BPSC(BP02,300))
  1. S BPRELCD=$TR($E($P(BP300,U,6),3,99)," ")
  1. S BPPSNCD=$TR($E($P(BP300,U,3),3,99)," ")
  1. S BPDOSDT=$$DOSDATE^BPSSCRRS(BPRXIEN,BPRXR)
  1. ;
  1. ;Effective Date
  1. S DIR(0)="DO",DIR("A")="Effective Date"
  1. K DIR("?") S DIR("?")="Enter the effective date for the Eligibility Verification transaction"
  1. S DIR("B")=$$FMTE^XLFDT(BPDOSDT,"5ZD")
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS
  1. S BPDOSDT=Y
  1. ;
  1. ;Relationship Code
  1. N X,DIC,Y
  1. S DIC("B")=BPRELCD
  1. S DIC(0)="QEAM",DIC=9002313.19,DIC("A")="Relationship Code: "
  1. D ^DIC
  1. ;Check for "^" or timeout
  1. I ($D(DUOUT))!($D(DTOUT)) S BPQ=-1 K X,DIC,Y G XPROMPTS
  1. S BPRELCD=$P(Y,U,2)
  1. K X,DIC,Y
  1. ;
  1. ;Person Code
  1. K DIR("?") S DIR(0)="FO^1:3",DIR("A")="Person Code",DIR("?")="Enter the Specific Person Code Assigned to the Patient by the Payer"
  1. S DIR("B")=BPPSNCD
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) S BPQ=-1 G XPROMPTS
  1. S BPPSNCD=Y
  1. ;
  1. ;Ask to proceed
  1. W ! S BPQ=$$YESNO^BPSSCRRS("Are you sure?(Y/N)")
  1. I BPQ'=1 S BPQ=-1 G XPROMPTS
  1. ;
  1. XPROMPTS ;
  1. Q BPQ
  1. ;
  1. ;Prompt User for Claim to Resubmit (w/EDITS)
  1. ;
  1. ; Input values -> BPROMPT - prompt string
  1. ; BPERRMES - the message to display when the user tries
  1. ; to make multi line selection (optional)
  1. ; Piece
  1. ;output values -> 1 - 1 = okay, <0 = errors, 0 = quit
  1. ; 2 - patient ien #2
  1. ; 3 - insurance ien #36
  1. ; 4 - ptr to #9002313.59
  1. ; 5 - 1st line for index(es) in LM "VALM" array
  1. ; 6 - patient's index
  1. ; 7 - claim's index
  1. ;
  1. ASKLINE(BPROMPT,BPERRMES) ;
  1. N BPRET,BPCNT
  1. S BPRET="",BPCNT=0
  1. F S BPRET=$$SELLINE^BPSSCRU4(BPROMPT,"C",VALMAR,"") Q:BPRET'<0 D
  1. . I BPCNT<1 S BPCNT=BPCNT+1 W !
  1. . E S BPCNT=0 D RE^VALM4
  1. . I BPRET=-1 W "Invalid line number" ; (invalid Patient summary line)"
  1. . I BPRET=-8 W $S($G(BPERRMES)]"":BPERRMES,1:" Invalid line number")
  1. . I BPRET=-4 W "Invalid line number" ; (invalid RX line)"
  1. . I BPRET=-2 W "Please select Patient's summary line."
  1. . I BPRET=-3 W "Please specify RX line."
  1. . I ",-1,-8,-4,-2,-3,"'[(","_BPRET_",") W "Incorrect format." ; Corrupted array (",BPRET,")"
  1. Q BPRET