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

BPSSCRU5.m

Go to the documentation of this file.
  1. BPSSCRU5 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,10**;JUN 2004;Build 27
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;USER SCREEN
  1. Q
  1. ;
  1. DATETIME(Y) ;EP - convert fileman date.time to printable
  1. X ^DD("DD")
  1. Q Y
  1. ;
  1. ;create a history of claims and responses in #9002313.57 file
  1. ;record for the specified transaction in #9002313.59 file
  1. ;input:
  1. ; BP59 - ptr to #9002313.59
  1. ; BPHIST - array to return results
  1. ;output:
  1. ; Array in BPHIST with the format:
  1. ; BPHIST(type,timedate,PointerToResponseClaimFile)=PointerTo#9002313.57^request type
  1. ; where:
  1. ; request type - "C" - billing request, "R" - reversal request
  1. ; type "C" - BPS CLAIM file, "R" - BPS RESPONSE file
  1. ; PointerToResponseClaimFile - pointer to 9002313.03 or 9002313.02
  1. MKHIST(BP59,BPHIST) ;
  1. N BP57,BPLSTCLM,BPLSTRSP,BPDAT57,BP1,BPSSTDT
  1. S BP57=0
  1. N BPSARR02
  1. N BPSARR03
  1. ; -- process BPS LOG OF TRANSACTIONS file
  1. F S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D
  1. . ;claim transmissions
  1. . S BPDAT57(0)=$G(^BPSTL(BP57,0))
  1. . S BPSSTDT=+$P(BPDAT57(0),U,11) ;start time
  1. . S BPLSTCLM=+$P(BPDAT57(0),U,4) ;claim
  1. . I BPLSTCLM>0 D
  1. . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on
  1. . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on
  1. . . ;old BPS CLAIMS recs don't have dates, so use START TIME from .57 file but
  1. . . ;only at the very first time (using $D for this)
  1. . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
  1. . . I BP1 I '$D(BPHIST("C",BP1,BPLSTCLM)) S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"C"
  1. . S BPLSTRSP=+$P(BPDAT57(0),U,5) ;response
  1. . I BPLSTRSP>0 D
  1. . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on
  1. . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
  1. . . I BP1 I '$D(BPHIST("R",BP1,BPLSTRSP)) S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"C"
  1. . ;reversal transmissions
  1. . S BPDAT57(4)=$G(^BPSTL(BP57,4))
  1. . S BPLSTCLM=+$P(BPDAT57(4),U,1) ;reversal
  1. . I BPLSTCLM>0 D
  1. . . S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,5) ;transmitted on
  1. . . I BP1=0 S BP1=+$P($G(^BPSC(BPLSTCLM,0)),U,6) ;rec created on
  1. . . I BP1=0 I '$D(BPSARR02(BPLSTCLM)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
  1. . . I BP1 I '$D(BPHIST("C",BP1,BPLSTCLM)) S BPHIST("C",BP1,BPLSTCLM)=BP57_U_"R"
  1. . S BPLSTRSP=+$P(BPDAT57(4),U,2) ;reversal response
  1. . I BPLSTRSP>0 D
  1. . . S BP1=+$P($G(^BPSR(BPLSTRSP,0)),U,2) ;received on
  1. . . I BP1=0 I '$D(BPSARR03(BPLSTRSP)) S (BPSARR02(BPLSTCLM))=BPSSTDT,BP1=BPSSTDT
  1. . . I BP1 I '$D(BPHIST("R",BP1,BPLSTRSP)) S BPHIST("R",BP1,BPLSTRSP)=BP57_U_"R"
  1. ;--------
  1. ;sorting: pairs (send/respond) in reversed chronological order
  1. N BPCLDT1,BPCLIEN,BPRSDT1,BPRSIEN,BPCLDT2
  1. S BPCLDT1=0
  1. F S BPCLDT1=$O(BPHIST("C",BPCLDT1)) Q:BPCLDT1="" D
  1. . S BPCLIEN=$O(BPHIST("C",BPCLDT1,0)) Q:BPCLIEN="" D
  1. . . S BPCLDT2=+$O(BPHIST("C",BPCLDT1))
  1. . . I BPCLDT2=0 S BPCLDT2=9999999
  1. . . S BPRSDT1=BPCLDT1
  1. . . F S BPRSDT1=$O(BPHIST("R",BPRSDT1)) Q:BPRSDT1=""!(BPRSDT1>BPCLDT2) D
  1. . . . S BPRSIEN=$O(BPHIST("R",BPRSDT1,0)) Q:BPRSIEN="" D
  1. . . . . S BPHIST("C",BPCLDT1,BPCLIEN,"R",BPRSIEN)=BPHIST("R",BPRSDT1,BPRSIEN)
  1. ;
  1. Q
  1. ;returns text for the transaction code in file #9002313.02 -- BPS CLAIMS FILE
  1. TRTYPE(BPTRCD) ;
  1. I BPTRCD="E1" Q "Eligibility Verification"
  1. I BPTRCD="B1" Q "REQUEST" ;"Billing"
  1. I BPTRCD="B2" Q "REVERSAL" ; "Reversal"
  1. I BPTRCD="B3" Q "Rebill"
  1. I BPTRCD="P1" Q "P.A. Request & Billing"
  1. I BPTRCD="P2" Q "P.A. Reversal"
  1. I BPTRCD="P3" Q "P.A. Inquiry"
  1. I BPTRCD="P4" Q "P.A. Request Only"
  1. I BPTRCD="N1" Q "Information Reporting"
  1. I BPTRCD="N2" Q "Information Reporting Reversal"
  1. I BPTRCD="N3" Q "Information Reporting Rebill"
  1. I BPTRCD="C1" Q "Controlled Substance Reporting"
  1. I BPTRCD="C2" Q "Controlled Substance Reporting Reversal"
  1. I BPTRCD="C3" Q "Controlled Substance Reporting Rebill"
  1. Q ""
  1. ;
  1. ;get NDC for LOG
  1. ;BPIEN02 - IEN in #9002313.02 file
  1. LNDC(BPIEN02) ;
  1. N BPDAT02,BPNDC
  1. S BPDAT02(400)=$G(^BPSC(BPIEN02,400,1,400))
  1. S BPNDC=$E($P(BPDAT02(400),U,7),3,99)
  1. S BPNDC=$E(BPNDC,1,5)_"-"_$E(BPNDC,6,9)_"-"_$E(BPNDC,10,11)
  1. Q BPNDC
  1. ;prepares array of reject codes
  1. ; BPIEN03 - IEN in #9002313.03 file
  1. ; BPRCODES - array to return results
  1. REJCODES(BPIEN03,BPRCODES) ;
  1. N BPA,BPR
  1. S BPA=0
  1. F S BPA=$O(^BPSR(BPIEN03,1000,1,511,BPA)) Q:'BPA D
  1. . S BPR=$P(^BPSR(BPIEN03,1000,1,511,BPA,0),U)
  1. . I BPR'="" S BPRCODES(BPR)=""
  1. Q
  1. ;status of the response
  1. RESPSTAT(BPIEN03) ;
  1. N BP1
  1. S BP1=$P($G(^BPSR(BPIEN03,1000,1,110)),U,2)
  1. Q:BP1="A" "Approved"
  1. Q:BP1="C" "Captured"
  1. Q:BP1="D" "Duplicate of Paid"
  1. Q:BP1="F" "PA Deferred"
  1. Q:BP1="P" "Paid"
  1. Q:BP1="Q" "Duplicate of Capture"
  1. Q:BP1="R" "Rejected"
  1. Q:BP1="S" "Duplicate of Approved"
  1. Q ""
  1. ;
  1. ;Electronic payer - ptr to #9002313.92
  1. ;BPIEN02 - ptr in #9002313.02
  1. B1PYRIEN(BP57) ;
  1. N BPX,BPX2
  1. S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,2)
  1. S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U)
  1. Q BPX
  1. ;
  1. ;BPIEN02 - ptr in #9002313.02
  1. B2PYRIEN(BP57) ;
  1. N BPX,BPX2
  1. S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,3)
  1. S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U)
  1. Q BPX
  1. ;
  1. ;B3 payer sheet
  1. B3PYRIEN(BP57) ;
  1. N BPX,BPX2
  1. S BPX2=+$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,4)
  1. S BPX=$P($G(^BPSF(9002313.92,BPX2,0)),U)
  1. Q BPX
  1. ;
  1. ;
  1. ;BPLN= line to use in SETLINE
  1. ;BPX - long string to display
  1. ;BPMLEN - max length
  1. ;BPPREFX - prefix string
  1. ;BPMARG - left margin
  1. WRAPLN(BPLN,BPX,BPMLEN,BPPREFX,BPMARG) ;
  1. N BPQ,BPLEN,BPXX
  1. S BPQ=0
  1. S BPLEN=BPMLEN-$L(BPPREFX)
  1. S BPXX=$E(BPX,1,BPLEN)
  1. D SETLINE^BPSSCRLG(.BPLN,BPPREFX_BPXX)
  1. S BPX=$E(BPX,BPLEN+1,9999)
  1. I $L(BPX)<1 Q
  1. S BPLEN=BPMLEN-BPMARG
  1. F D Q:BPQ=1
  1. . S BPXX=$E(BPX,1,BPLEN)
  1. . D SETLINE^BPSSCRLG(.BPLN,$$SPACES(BPMARG)_BPXX)
  1. . S BPX=$E(BPX,BPLEN+1,9999)
  1. . I $L(BPX)<1 S BPQ=1
  1. Q
  1. ;
  1. ;to prepare spaces
  1. SPACES(BPN) ;
  1. N BPX
  1. S $P(BPX," ",BPN+1)=""
  1. Q BPX
  1. ;
  1. ;BPN= line counter (index)
  1. ;BPARR - array for lines
  1. ;BPX - long string to display
  1. ;BPMLEN - mas length
  1. ;BPPREFX - prefix string
  1. ;BPMARG - left margin
  1. WRAPLN2(BPN,BPARR,BPX,BPMLEN,BPPREFX,BPMARG) ;
  1. N BPQ,BPLEN,BPXX
  1. S BPQ=0
  1. S BPLEN=BPMLEN-$L(BPPREFX)
  1. S BPXX=$E(BPX,1,BPLEN)
  1. D SETLN(.BPN,.BPARR,BPPREFX_BPXX)
  1. S BPX=$E(BPX,BPLEN+1,9999)
  1. I $L(BPX)<1 Q
  1. S BPLEN=BPMLEN-BPMARG
  1. F D Q:BPQ=1
  1. . S BPXX=$E(BPX,1,BPLEN)
  1. . D SETLN(.BPN,.BPARR,$$SPACES(BPMARG)_BPXX)
  1. . S BPX=$E(BPX,BPLEN+1,9999)
  1. . I $L(BPX)<1 S BPQ=1
  1. Q
  1. ;
  1. ;
  1. SETLN(BPN,BPARR,BPTXT) ;
  1. S BPN=BPN+1,BPARR(BPN)=BPTXT
  1. Q
  1. ;---
  1. ;check 2nd insurance
  1. ;if there then ask user and print message
  1. CH2NDINS(BP59,BPPATNAM,BPINSNAM,BPRXINFO) ;
  1. N BPRETV
  1. S BPRETV=$$NEXTINS^BPSSCRCL(BP59,BPINSNAM)
  1. Q:+BPRETV=0
  1. D PRN(BPPATNAM,BPRETV,.BPRXINFO,"S")
  1. W !!
  1. I $$YESNO^BPSSCRRS("Do you want to print the information (above) concerning additional insurance? (Y/N)")'=1 Q
  1. D PRN(BPPATNAM,BPRETV,.BPRXINFO,"P")
  1. Q
  1. ;
  1. ;BPPRNFL
  1. ; S- print to screen
  1. PRN(BPPATNAM,BPRETV,BPRXINFO,BPPRNFL) ;
  1. I BPPRNFL="S" W @IOF D MS2NDINS Q
  1. D PRINT("MS2NDINS^BPSSCRU5","BPS 2ND INSURANCE INFO","BP*")
  1. W !!
  1. Q
  1. ;
  1. MS2NDINS ;
  1. N Y,Z
  1. W !,"This patient has ADDITIONAL insurance with Rx Coverage that may be"
  1. W !,"used to bill this claim. The system will change the CT entry to a"
  1. W !,"NON-BILLABLE Episode. If appropriate, please go to the ECME Pharmacy"
  1. W !,"COB menu and use the PRO - Process Secondary/TRICARE Rx to ECME"
  1. W !,"option to create an ePharmacy secondary claim."
  1. W !!,"Patient: ",?18,BPPATNAM
  1. S Y=$P(BPRETV,U,4)\1 D DD^%DT
  1. W !,"Date of service: ",?18,Y
  1. W !,"Insurance: ",?18,$P(BPRETV,U,2)
  1. W !,"Group number: ",?18,$P(BPRETV,U,3)
  1. S Z=0 F S Z=$O(BPRXINFO(Z)) Q:+Z=0 W !,BPRXINFO(Z)
  1. Q
  1. ;
  1. ;Prints report
  1. ;propmpts user to choose device (including queuing)
  1. ;TXTSRC - name of the report's entry point
  1. ;DESCR - description for the Task Manager
  1. ;SAVEVARS - mask for vars that need to be available in the report
  1. ; (exmpl: "BP*")
  1. PRINT(TXTSRC,DESCR,SAVEVARS) ;
  1. N Y,QUITVAR,SCRFLAG
  1. S (QUITVAR,SCRFLAG)=0
  1. D DEVICE Q:QUITVAR
  1. D @TXTSRC
  1. D ^%ZISC
  1. I QUITVAR W !,"Cancelled"
  1. Q
  1. ;
  1. DEVICE ;
  1. N DIR,DIRUT,POP
  1. N ZTRTN,ZTIO,ZTSAVE,ZTDESC,%ZIS
  1. K IO("Q") S %ZIS="QM"
  1. W ! D ^%ZIS
  1. I POP S QUITVAR=1 Q
  1. S SCRFLAG=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. I $D(IO("Q")) D S QUITVAR=1
  1. . S ZTRTN=TXTSRC
  1. . S ZTIO=ION
  1. . S ZTSAVE(SAVEVARS)=""
  1. . S ZTDESC=DESCR
  1. . D ^%ZTLOAD
  1. . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1. . D HOME^%ZIS
  1. U IO
  1. Q
  1. ;