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