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

BPSSCRU3.m

Go to the documentation of this file.
  1. BPSSCRU3 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,8,9,10,20,21**;JUN 2004;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;USER SCREEN
  1. Q
  1. ;get comment from BPS TRANSACTION file
  1. ;BP59 - ien in that file
  1. COMMENT(BP59) ;
  1. N BPCMNT,BPX,BPTXT
  1. S BPCMNT=$O(^BPST(BP59,11,999999),-1)
  1. I BPCMNT="" Q ""
  1. S BPX=$G(^BPST(BP59,11,BPCMNT,0))
  1. ; If the date/time of the comment is earlier than the date/time of
  1. ; the Submit Date, then do not display the comment (BPS*1*21)
  1. I $P(BPX,U,1)<$P($G(^BPST(BP59,0)),U,7) Q "Prior comments suppressed-use CMT action for all comments"
  1. S BPTXT=$P(BPX,U,3) I $L(BPTXT)>60 S BPTXT=$S(+$P(BPX,U,4):$E(BPTXT,1,50)_"...",1:$E(BPTXT,1,58)_"...")
  1. Q $$DATTIM($P(BPX,U,1)\1)_$S(+$P(BPX,U,4):" (Pharm)",1:"")_" - "_BPTXT_U_$$USERNAM^BPSCMT01($P(BPX,U,2))
  1. ;
  1. DATTIM(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format.
  1. I +X=0 W ""
  1. N DATE,YR,BPT,BPM,BPH,BPAP
  1. I $G(X) S YR=$E(X,2,3)
  1. I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
  1. S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT))
  1. S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4)
  1. S BPAP="a" I BPH>12 S BPH=BPH-12,BPAP="p" S:$L(BPH)<2 BPH="0"_BPH
  1. I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP
  1. Q $G(DATE)
  1. ;/**
  1. ;a wrapper for $$STATUS^BPSOSRX to get the status by BPS TRANSACTION pointer
  1. ;input BP59 - ptr to 9002313.59
  1. ;output - pieces 1,2 and 3 of the $$STATUS^BPSOSRX output
  1. ; example: "E REVERSAL ACCEPTED^3071206.152829^Reversal Accepted"
  1. CLAIMST(BP59) ;*/
  1. N BPX,BPSTATUS,BPREF,BPSCHED
  1. N BPCOB S BPCOB=$$COB59^BPSUTIL2(BP59)
  1. S BPSCHED=0
  1. S BPX=$$RXREF^BPSSCRU2(BP59)
  1. S BPREF=$P(BPX,U,2)
  1. S BPSTATUS=$$STATUS^BPSOSRX(+BPX,BPREF,,,BPCOB)
  1. ;if the request completed (99%) and there is another active (scheduled, activated,
  1. ;in process,completed but not inactivated yet) request then return IN PROGRESS
  1. I $P(BPSTATUS,U,4)=99,$$ACTREQS^BPSOSRX6(+BPX,BPREF,BPCOB) S BPSCHED=1
  1. I BPSCHED I ($P(BPSTATUS,U)="E PAYABLE")!($P(BPSTATUS,U)="E REVERSAL ACCEPTED") Q "IN PROGRESS"_U_$P(BPSTATUS,U,2)
  1. Q $P(BPSTATUS,U,1,3)
  1. ;
  1. ;/**
  1. ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
  1. ;B59 - ptr to #9002313.59
  1. ;BPRESP - ptr to #9002313.03
  1. ;BPPOS - position inside #9002313.03 (i.e. the number
  1. ;of the claim in the transmission - currently we always have only 1
  1. GRESPPOS(BP59,BPRESP,BPPOS) ;*/
  1. I $G(^BPST(BP59,4)) D ; reversal kind of message
  1. . S BPRESP=+$P(^BPST(BP59,4),U,2)
  1. . S BPPOS=1
  1. E D
  1. . S BPRESP=+$P($G(^BPST(BP59,0)),U,5)
  1. . S BPPOS=+$P($G(^BPST(BP59,0)),U,9)
  1. Q:+BPRESP=0 0
  1. Q:+BPPOS=0 0
  1. Q 1
  1. ;
  1. ;/**
  1. ;Messages from the BPS RESPONSE file
  1. ;BP59 - ptr to 9002313.59
  1. ;FIELD - what field to get
  1. ;
  1. GETMESS(FIELD,BP59) ;
  1. I '$G(FIELD) Q ""
  1. I '$G(BP59) Q ""
  1. N BPRESP,BPPOS
  1. ; Get response and position in the BPS RESPONSE file
  1. I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q ""
  1. ; 504-F4 (Message)
  1. I FIELD=504 Q $P($G(^BPSR(BPRESP,504)),U)
  1. ; 526-FQ (Additional Message Information) - Get first entry of the multiple)
  1. I FIELD=526 N MESSAGE,N D Q MESSAGE
  1. . N ADDMESS
  1. . D ADDMESS^BPSSCRLG(BPRESP,BPPOS,.ADDMESS)
  1. . S MESSAGE=""
  1. . S N=$O(ADDMESS(""))
  1. . I N S MESSAGE=$E(ADDMESS(N),1,200)
  1. Q ""
  1. ;
  1. ;reject message from RESPONSE file
  1. ;BP59 - ptr to 9002313.59
  1. ;BPARR1 - array to return messages (by ref)
  1. ;BPN1 - index for the array (by ref - will
  1. ; be incremented if more than one node added)
  1. ;BPMLEN - max length for each string
  1. ;PBPREF - for prefix string
  1. ;compare GETRJCOD from BPSSCRU2
  1. GETRJCOD(BP59,BPARR1,BPN1,BPMLEN,PBPREF) ;
  1. N BP59DAT S BP59DAT=$G(^BPST(BP59,0))
  1. N BPRESP,BPPOS
  1. N BPRJCOD
  1. N BPRJTXT
  1. N BPSTR
  1. N BPRJ
  1. ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
  1. ;get response and position
  1. I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q
  1. S BPRJ=0
  1. S BPSTR=""
  1. F S BPRJ=$O(^BPSR(BPRESP,1000,BPPOS,511,BPRJ)) Q:+BPRJ=0 D
  1. . S BPRJCOD=$P($G(^BPSR(BPRESP,1000,BPPOS,511,BPRJ,0)),U)
  1. . Q:$L(BPRJCOD)=0
  1. . S BPRJTXT=$$GETRJNAM(BPRJCOD)
  1. . S BPN1=BPN1+1,BPARR1(BPN1)=PBPREF_BPRJTXT
  1. Q BPN1
  1. ;/**
  1. ;Input:
  1. ; BP59 - pointer to file #9002313.59
  1. ; BPSNBR - flag to determine if eT/eC pseudo-reject codes should also be returned for non-billable entries
  1. ; default is to NOT include them (leave parameter blank)
  1. ;Output:
  1. ; BPRCODES - array for reject codes by reference
  1. REJCODES(BP59,BPRCODES,BPSNBR) ;get reject codes
  1. N BPRESP,BPPOS,BPA,BPR
  1. ;
  1. ; get TRI/CVA non-billable pseudo-reject codes if the flag is set and the entry is non-billable (BPS*1*20)
  1. I $G(BPSNBR),$$NB^BPSSCR03(BP59) D
  1. . S BPR=$E($$EREJTXT^BPSSCR03(BP59),1,2) ; get the eT or eC pseudo-reject code
  1. . I BPR'="" S BPRCODES(BPR)=""
  1. . Q
  1. ;
  1. ;pointers for RESPONSE file (#9002313.03) by pointer in TRANSACTION file #9002313.59
  1. ;get response and position
  1. I $$GRESPPOS(BP59,.BPRESP,.BPPOS)=0 Q
  1. ;
  1. S BPA=0
  1. F S BPA=$O(^BPSR(BPRESP,1000,BPPOS,511,BPA)) Q:'BPA D
  1. . S BPR=$P(^BPSR(BPRESP,1000,BPPOS,511,BPA,0),U)
  1. . I BPR'="" S BPRCODES(BPR)=""
  1. Q
  1. ;/**
  1. ;BPRJCODE - code
  1. GETRJNAM(BPRJCODE) ;*/
  1. N BPRJIEN
  1. S BPRJIEN=$O(^BPSF(9002313.93,"B",BPRJCODE,0))
  1. Q:+BPRJIEN=0 ""
  1. Q BPRJCODE_":"_$P($G(^BPSF(9002313.93,BPRJIEN,0)),U,2)
  1. ;/**
  1. ;BP59 - ptr to 9002313.59
  1. ;was the claim ever autoreversed ?
  1. AUTOREV(BP59) ;*/
  1. N BP02
  1. S BP02=+$P($G(^BPST(BP59,0)),U,4)
  1. Q +$P($G(^BPSC(BP02,0)),U,7)
  1. ;
  1. ;/**
  1. ;BP59 - ptr to 9002313.59
  1. ;returns :
  1. ;0 Waiting to start
  1. ;10 Gathering claim info
  1. ;19 Special Grouping
  1. ;30 Waiting for packet build
  1. ;31 Wait for retry (insurer asleep)
  1. ;40 Packet being built
  1. ;50 Waiting for transmit
  1. ;51 Wait for retry (comms error)
  1. ;60 Transmitting
  1. ;70 Receiving Response
  1. ;80 Waiting to process response
  1. ;90 Processing response
  1. ;99 Done
  1. ;
  1. PRCNTG(BP59) ;*/
  1. Q +$P($G(^BPST(BP59,0)),U,2)
  1. ;
  1. ;
  1. LINE(BPN,BPCH) ;
  1. N BP1
  1. S $P(BP1,BPCH,BPN+1)=""
  1. Q BP1
  1. ;
  1. DTTIME(X) ;Convert FM date to displayable (mm/dd/yy HH:MM) format.
  1. I +X=0 W ""
  1. N DATE,YR,BPT,BPM,BPH,BPAP,BPS
  1. I $G(X) S YR=$E(X,1,3)+1700
  1. I $G(X) S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_YR,1:"")
  1. S BPT=$P(X,".",2)
  1. I BPT S:$L(BPT)<6 BPT=BPT_$E("000000",1,6-$L(BPT))
  1. S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4),BPS=$E(BPT,5,6)
  1. I BPT S DATE=DATE_"@"_BPH_":"_BPM_":"_BPS
  1. Q $G(DATE)
  1. ;
  1. ;call IB API to get insurance data, then select proper insurance by its name
  1. ;get its phone number
  1. ;input:
  1. ; DFN - patient IEN in #2
  1. ; BPDOS - date of service
  1. ; BPINSNM - insurance name
  1. ;output: insurance ien^insurance name^phone
  1. GETPHONE(BPDFN,BPDOS,BPINSNM) ;
  1. N BPX,BPZZ,BP1,BPPHONE
  1. S BPPHONE=""
  1. I $$INSUR^IBBAPI(BPDFN,BPDOS,,.BPZZ,"1,6")'=1 Q ""
  1. S BP1="" F S BP1=$O(BPZZ("IBBAPI","INSUR",BP1)) Q:+BP1=0 D
  1. . I BPINSNM=$P($G(BPZZ("IBBAPI","INSUR",BP1,1)),U,2) S BPPHONE=$G(BPZZ("IBBAPI","INSUR",BP1,6)) Q
  1. Q BPPHONE
  1. ;
  1. ;try to get insurance name and phone from #9002313.59, #9002313.57 and from INSUR^IBBAPI
  1. ;input: BP59 - ien in #9002313.59
  1. ;return insurance_name^phone#
  1. NAMEPHON(BP59) ;
  1. N BPHONE,BPINSNM,BPINSID,BP57,BPINSN
  1. S BPHONE=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),3)),U,2)
  1. S BPINSNM=$P($G(^BPST(BP59,10,+$G(^BPST(BP59,9)),0)),U,7)
  1. S BP57=0
  1. F Q:(BPHONE'="")&(BPINSNM'="") S BP57=$O(^BPSTL("B",BP59,BP57)) Q:+BP57=0 D
  1. . S BPINSN=+$G(^BPSTL(BP57,9))
  1. . S:BPHONE="" BPHONE=$P($G(^BPSTL(BP57,10,BPINSN,3)),U,2)
  1. . S:BPINSNM="" BPINSNM=$P($G(^BPSTL(BP57,10,BPINSN,0)),U,7)
  1. ;
  1. I (BPINSNM'="")&(BPHONE="") D
  1. . S BPDOS=+$P($G(^BPST(BP59,12)),U,2)\1
  1. . I BPDOS=0 S BPDOS=+$P($G(^BPST(BP59,0)),U,8)\1
  1. . S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
  1. . S BPHONE=$$GETPHONE(BPDFN,BPDOS,BPINSNM)
  1. Q BPINSNM_U_BPHONE
  1. ;
  1. COM(BPSRXI,BPSRXR,BPSCOB,BPSARRAY) ; Get Comments
  1. ; This API retrieves comments for pharmacist from BPS Transaction.
  1. ;
  1. ; Input: BPSRXI - Prescription IEN (Pointer to the PRESCRIPTION
  1. ; file (#52). This parameter is required.
  1. ; BPSRXR - Fill Number (0 for original, 1 for 1st refill,
  1. ; 2 for the 2nd refill, etc.). If this parameter
  1. ; is missing, it will default to zero.
  1. ; BPSCOB - Coordination of Benefit value (1-Primary,
  1. ; 2-Secondary, 3-Tertiary). If not passed in,
  1. ; primary is assumed.
  1. ;
  1. ; Output: BPSARRAY - Return array of data in the format of:
  1. ; Array Name(Transaction Date,Count Index)=Pharmacy Flag ^
  1. ; Comment ^ User entering comment
  1. ;
  1. N BP59,BPSI,BPSCNT,BPSPFLG,BPSDATE,BPSUSER,BPSCOM,BPSX
  1. ;
  1. I '$G(BPSRXI) Q
  1. ;
  1. ; Note that $$IEN59^BPSOSRX will treat BPSRXR="" as the original
  1. ; fill (0) and BPSCOB="" as primary (1)
  1. S BP59=$$IEN59^BPSOSRX(BPSRXI,$G(BPSRXR),$G(BPSCOB))
  1. I '$D(^BPST(BP59,0)) Q
  1. ;
  1. S (BPSI,BPSCNT)=0
  1. F S BPSI=$O(^BPST(BP59,11,BPSI)) Q:'BPSI D
  1. .S BPSPFLG=$$GET1^DIQ(9002313.59111,BPSI_","_BP59,.04,"I")
  1. .S BPSDATE=$$GET1^DIQ(9002313.59111,BPSI_","_BP59,.01,"I")
  1. .S BPSUSER=$$GET1^DIQ(9002313.59111,BPSI_","_BP59,.02,"I")
  1. .S BPSCOM=$$GET1^DIQ(9002313.59111,BPSI_","_BP59,.03)
  1. .;
  1. .S BPSX=BPSPFLG_"^"_BPSCOM_"^"_BPSUSER
  1. .S BPSCNT=BPSCNT+1
  1. .S BPSARRAY(BPSDATE,BPSCNT)=BPSX
  1. Q
  1. ;