- BPSSCRU2 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
- ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,10,11,20**;JUN 2004;Build 27
- ;;Per VA Directive 6402, this routine should not be modified.
- ;USER SCREEN
- Q
- ;/**
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ;get filling "location" like "WINDOW/LOCALMAIL/CMOP"
- GETMWC(BP59) ;*/
- N BP1 S BP1=$$RXREF(BP59)
- Q:+BP1=0 ""
- Q $$MWC($P(BP1,U),$P(BP1,U,2))
- ;
- ;initially this was designed to convert numbers to letters to display on the screen
- ;but later the Pharmacy designed API that returns letters instead of numbers
- ;so now this function just returns what it receives in its parameter, while it does not
- ;make any sense, we still keep it in order to prevent changes in other four routines:
- ; BPSREOP1, BPSSCR02, BPSSCR03, BPSSCR04
- MWCNAME(BPMWC) ;
- Q BPMWC
- ;/**
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ;get RX pointer in file #52 and refill number in its multiple (0 - original refill)
- RXREF(BP59) ;
- N BPRX,BPREF
- S BPRX=+$P($G(^BPST(BP59,1)),U,11) ;ptr to RX node in #52
- S BPREF=+$P($G(^BPST(BP59,1)),U) ;ptr to refill multiple in #52
- Q BPRX_U_BPREF
- ; determines if the refill was MAIL/WINDOW/CMOP
- MWC(BPRX,BPREF) ;MAIL/WINDOW/CMOP
- ;input:
- ; BPRX ptr to #52 (RX)
- ; BPREF ptr to #52.1 (refills)
- ;return value:
- ; 2-MAIL/3-WINDOW/4-CMOP
- Q $$MWC^PSOBPSU2(BPRX,BPREF)
- ;
- ;
- ;/**
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ; insurance ien ^ name ^ phone
- GETINSUR(BP59) ;get insurance info by the pointer of #9002313.59
- N BPHONE,BPINSNM,BPINSID,BP57,BPINSN,BPX
- S BPX=$$NAMEPHON^BPSSCRU3(BP59)
- S BPINSNM=$P(BPX,U,1)
- S BPHONE=$P(BPX,U,2)
- ;Get a temporary ID for the insurance from ^TMP list of insurances.
- ;If doesn't exist yet then create a new record in ^TMP list of insurances
- ; for this insurance and return the ID for the record.
- ;A lifetime for ^TMP list of insurances is the time period the user is using
- ; the User Screen menu option
- S BPINSID=$$CHKINSUR^BPSSCR(BPINSNM,BPHONE)
- I $L(BPHONE)=0 S BPHONE=" "
- I $L(BPINSNM)=0 S BPINSNM="?NODATA?"
- Q BPINSID_U_BPINSNM_U_BPHONE
- ;
- ;/**
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ;transaction date
- TRANDT(BP59) ;
- Q $P($G(^BPST(BP59,0)),U,8)\1
- ;
- ;/**
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ;ECME pharmacy division (9002313.56)
- DIVIS(BP59) ;
- Q $P($G(^BPST(BP59,1)),U,7)
- ;
- ;/**
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ;patient's DFN (file #2)
- GETPATID(BP59) ;
- Q $P($G(^BPST(BP59,0)),U,6)
- ;
- ;return RX status as ACT/DIS/etc
- RXST(BP59) ;
- N BPRXREF
- S BPRXREF=$$RXREF^BPSSCRU2(BP59)
- ;display status ONLY if the refill is the most recent
- ;otherwise display blanks (three spaces for sorting purposes)
- I +$P(BPRXREF,U,2)'=(+$$LSTRFL^PSOBPSU1(+$P(BPRXREF,U,1))) Q "**"
- Q $$RXSTANAM($$RXSTATUS(+$P(BPRXREF,U,1)))
- ;/**
- ;RX status
- ;Input
- ; RXNUM:
- ; ien of file #52 (if MODE=0)
- ; or RX number (if MODE=1)
- ;----------
- ;Output:
- ; 0 if not found
- ; status set#
- RXSTATUS(RXNUM) ;*/
- N BPRET
- S BPRET=$$RXAPI1^BPSUTIL1(RXNUM,100,"I")
- I BPRET="" Q -1
- Q BPRET
- ;/**
- ;if RX "valid"
- RXACTIVE(BPRXSTAT) ;*/
- ; 0 not valid
- ; 1 valid (i.e. ACTIVE/NON-VERIFIED/REFILL/HOLD/DRUG INTERACTIONS/SUSPENDED)
- ; -1 doesn't exist
- Q:BPRXSTAT<6 1 ;active
- ;/**
- ;RX status text
- RXSTANAM(BPRXSTAT) ;*/
- Q:BPRXSTAT=0 "AC" ; ACTIVE;
- Q:BPRXSTAT=1 "NV" ; NON-VERIFIED;
- Q:BPRXSTAT=3 "HL" ; HOLD;
- Q:BPRXSTAT=5 "SU" ; SUSPENDED;
- Q:BPRXSTAT=11 "EX" ; EXPIRED;
- Q:BPRXSTAT=12 "DS" ; DISCONTINUED;
- Q:BPRXSTAT=13 "DL" ; DELETED;
- Q:BPRXSTAT=14 "DS" ; DISCONTINUED BY PROVIDER;
- Q:BPRXSTAT=15 "DS" ; DISCONTINUED (EDIT);
- Q:BPRXSTAT=16 "HL" ; PROVIDER HOLD;
- Q:BPRXSTAT=-1 "??"
- Q ""
- ;/**
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ;returns:
- ;>0 Released
- ;0 non released
- ;-1 error
- ISRXREL(BP59) ;
- N BP1
- S BP1=$$REFILINF(BP59)
- Q:BP1<0 -1
- Q $P(BP1,U,2) ; i.e. it is non-released if there is no any release date
- ;
- ;release status
- RL(BP59) ;
- Q $S($$ISRXREL(BP59)>0:"R",1:"N")
- ;/**
- ;get refill (including original refill) info by BP59
- ;Input:
- ; BP59 - pointer to file #9002313.59
- ;Output:
- ;returns:
- ;on error : "-1"
- ;on success : refill# ^ release date ^label print date ^ fill date ^ issue date
- REFILINF(BP59) ;*/
- N BP1 S BP1=$$RXREF(BP59)
- N BPRX S BPRX=$P(BP1,U,1) ;ptr to #52
- N BPREF S BPREF=$P(BP1,U,2) ;ptr in its refill multiple
- I BPREF,$$IFREFILL(BPRX,BPREF)=0 Q -1 ;if bad data
- ;original refill
- I BPREF=0 Q "0"_U_$$RXRELDT(BPRX)_U_U_$$RXFILDT(BPRX)_U_$$RXISSDT(BPRX)
- ;refill's release date
- I BPREF>0 Q BPREF_U_$$REFRELDT(BPRX,BPREF)_U_U_$$REFFILDT(BPRX,BPREF)_U_$$REFISSDT(BPRX,BPREF)
- Q -1
- ;
- ;-Prescriptions-----------------------
- ;RX issue date
- RXISSDT(BPRX) ;
- Q +$$RXAPI1^BPSUTIL1(BPRX,1,"I")
- ;
- ;RX's release date
- RXRELDT(BPRX) ;
- Q +$$RXAPI1^BPSUTIL1(BPRX,31,"I")
- ;
- ;RX's fill date
- RXFILDT(BPRX) ;
- Q +$$RXAPI1^BPSUTIL1(BPRX,22,"I")
- ;
- ;refill's release date
- REFRELDT(BPRX,BPREF) ;
- Q +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,17,"I")
- ;
- ;refill's refill date
- REFFILDT(BPRX,BPREF) ;
- Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I")
- ;
- ;refill's issue date
- REFISSDT(BPRX,BPREF) ;
- Q $$REFDISDT(BPRX,BPREF)
- ;
- ;refill's dispense date
- REFDISDT(BPRX,BPREF) ;
- Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,10.1,"I")
- ;
- ;if refill exists
- IFREFILL(BPRX,BPREF) ;
- Q $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I")'=""
- ;/**
- ;input
- ;ptr to 9002313.59
- ;output :
- ; BB - back billing
- ; P2 - PRO Option
- ; RS - ECME user screen resubmission (BPS*1*20)
- ; RT - all other values in (#1201) RX ACTION field on 9002313.59
- RTBB(BP59) ;*/
- N BPTRBB
- S BPTRBB=$P($G(^BPST(BP59,12)),U)
- I BPTRBB="" Q "**"
- I BPTRBB="BB" Q "BB"
- I BPTRBB="P2" Q "P2"
- I BPTRBB="P2S" Q "P2"
- I BPTRBB="ERES" Q "RS" ; ECME user screen resubmit (BPS*1*20)
- I BPTRBB="ERWV" Q "RS" ; ECME user screen resubmit/without reversal (BPS*1*20)
- I BPTRBB="ERNB" Q "RS" ; ECME user screen resubmit TRI/CVA non-billable (BPS*1*20)
- Q "RT"
- ;
- ;------------ patient's name
- PATNAME(BPDFN) ;
- Q $E($P($G(^DPT(BPDFN,0)),U),1,15)
- ;
- SSN4(DFN) ;last 4 SSN
- N X
- S X=$P($G(^DPT(DFN,0)),U,9)
- Q "("_$E(X,$L(X)-3,$L(X))_")"
- ;
- ;get drug generic name
- DRGNAM(BP50) ;
- ;BP50 - ptr to #50
- Q $E($$DRUGDIE^BPSUTIL1(BP50,.01,"E"),1,35)
- ;get drug
- GETDRUG(BP52) ;
- ;return value:
- ; 0 - unknown
- ; n - ptr to DRUG file #50
- Q +$$RXAPI1^BPSUTIL1(BP52,6,"I")
- ;
- GETDRG59(BP59) ;
- N BPX
- S BPX=$$RXREF(BP59)
- Q $$GETDRUG(+BPX)
- ;
- ;
- ;review %% for each of claims in the array
- ;and calculate "overall" "done" status
- ;input:
- ; BPARR59 - array of ptr to #9002313.59
- ;output:
- ; status
- FINISHST(BPARR59) ;
- N BPFIN,BP59
- S BPFIN=1,BP59=0
- F S BP59=$O(BPARR59(BP59)) Q:+BP59=0 D Q:BPFIN=0
- . I $$PRCNTG^BPSSCRU3(BP59)<99 S BPFIN=0
- I BPFIN=1 Q "**FINISHED**"
- Q ""
- ;
- ;
- ;BPRX - ptr to #52
- RXNUM(BPRX) ;
- Q $$RXAPI1^BPSUTIL1(BPRX,.01,"E")_$S(+$$RXAPI1^BPSUTIL1(BPRX,105,"I"):"$",1:"")
- ;
- ;/**
- ;get NDC
- ;input
- ;BPRX - ptr to #52
- ;BPREF - refill # (0,1,2,3...)
- NDC(BPRX,BPREF) ;*/
- N X
- S X=$TR($$GETNDC^PSONDCUT(BPRX,BPREF),"-","") ;remove dashes
- Q X
- ;
- DRGNAME(BP59) ;drug name BP59 -ptr to .59 file
- N BPRX
- S BPRX=+$P($G(^BPST(BP59,1)),U,11) ;ptr to RX node in #52
- Q $E($$DRGNAM($$GETDRUG(BPRX)),1,23)
- ;
- ;is the number even?
- ;1-yes
- ;0 -no
- ISEVEN(BPNUM) ;
- Q ((BPNUM/2)-(BPNUM\2))=0
- ;
- ;BPSTR - string to format
- ;BPSMLEN - max lenght
- ;BPSCHR - char to add
- ;BPSLFT - 1 - add from the left, 0 - from the right
- FORMAT(BPSTR,BPSMLEN,BPSCHR,BPSLFT) ;
- N LN S LN=$L(BPSTR)
- N ZZ S ZZ=""
- I LN=BPSMLEN Q BPSTR
- I LN>BPSMLEN Q:BPSLFT $E(BPSTR,LN-BPSMLEN+1,9999) Q $E(BPSTR,1,BPSMLEN)
- S $P(ZZ,BPSCHR,BPSMLEN-LN+1)=""
- Q:BPSLFT ZZ_BPSTR
- Q BPSTR_ZZ
- ;
- ;/**
- ;BP59 - ptr to 9002313.59
- ;output :
- ;ECME number from 9002313.02
- ; 7 or 12 digits of the prescription IEN file 52
- ; or 12 spaces
- N BPST0,BPST4,PC,PF,PR,X
- S BPST0=$G(^BPST(BP59,0)),PC=$P(BPST0,U,4),PF=$P(BPST0,U,9)
- S BPST4=$G(^BPST(BP59,4)),PR=$P(BPST4,U,1)
- I PR]"" S PC=PR ;This is a reversal
- I PC=""!(PF="") Q $$FORMAT("",12," ",1)
- S X=$P($G(^BPSC(PC,400,PF,400)),U,2)
- I X="" Q $$FORMAT(X,12," ",1)
- Q $E(X,3,14)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRU2 8478 printed Jan 18, 2025@02:54:33 Page 2
- BPSSCRU2 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,10,11,20**;JUN 2004;Build 27
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;USER SCREEN
- +4 QUIT
- +5 ;/**
- +6 ;Input:
- +7 ; BP59 - pointer to file #9002313.59
- +8 ;Output:
- +9 ;get filling "location" like "WINDOW/LOCALMAIL/CMOP"
- GETMWC(BP59) ;*/
- +1 NEW BP1
- SET BP1=$$RXREF(BP59)
- +2 if +BP1=0
- QUIT ""
- +3 QUIT $$MWC($PIECE(BP1,U),$PIECE(BP1,U,2))
- +4 ;
- +5 ;initially this was designed to convert numbers to letters to display on the screen
- +6 ;but later the Pharmacy designed API that returns letters instead of numbers
- +7 ;so now this function just returns what it receives in its parameter, while it does not
- +8 ;make any sense, we still keep it in order to prevent changes in other four routines:
- +9 ; BPSREOP1, BPSSCR02, BPSSCR03, BPSSCR04
- MWCNAME(BPMWC) ;
- +1 QUIT BPMWC
- +2 ;/**
- +3 ;Input:
- +4 ; BP59 - pointer to file #9002313.59
- +5 ;Output:
- +6 ;get RX pointer in file #52 and refill number in its multiple (0 - original refill)
- RXREF(BP59) ;
- +1 NEW BPRX,BPREF
- +2 ;ptr to RX node in #52
- SET BPRX=+$PIECE($GET(^BPST(BP59,1)),U,11)
- +3 ;ptr to refill multiple in #52
- SET BPREF=+$PIECE($GET(^BPST(BP59,1)),U)
- +4 QUIT BPRX_U_BPREF
- +5 ; determines if the refill was MAIL/WINDOW/CMOP
- MWC(BPRX,BPREF) ;MAIL/WINDOW/CMOP
- +1 ;input:
- +2 ; BPRX ptr to #52 (RX)
- +3 ; BPREF ptr to #52.1 (refills)
- +4 ;return value:
- +5 ; 2-MAIL/3-WINDOW/4-CMOP
- +6 QUIT $$MWC^PSOBPSU2(BPRX,BPREF)
- +7 ;
- +8 ;
- +9 ;/**
- +10 ;Input:
- +11 ; BP59 - pointer to file #9002313.59
- +12 ;Output:
- +13 ; insurance ien ^ name ^ phone
- GETINSUR(BP59) ;get insurance info by the pointer of #9002313.59
- +1 NEW BPHONE,BPINSNM,BPINSID,BP57,BPINSN,BPX
- +2 SET BPX=$$NAMEPHON^BPSSCRU3(BP59)
- +3 SET BPINSNM=$PIECE(BPX,U,1)
- +4 SET BPHONE=$PIECE(BPX,U,2)
- +5 ;Get a temporary ID for the insurance from ^TMP list of insurances.
- +6 ;If doesn't exist yet then create a new record in ^TMP list of insurances
- +7 ; for this insurance and return the ID for the record.
- +8 ;A lifetime for ^TMP list of insurances is the time period the user is using
- +9 ; the User Screen menu option
- +10 SET BPINSID=$$CHKINSUR^BPSSCR(BPINSNM,BPHONE)
- +11 IF $LENGTH(BPHONE)=0
- SET BPHONE=" "
- +12 IF $LENGTH(BPINSNM)=0
- SET BPINSNM="?NODATA?"
- +13 QUIT BPINSID_U_BPINSNM_U_BPHONE
- +14 ;
- +15 ;/**
- +16 ;Input:
- +17 ; BP59 - pointer to file #9002313.59
- +18 ;Output:
- +19 ;transaction date
- TRANDT(BP59) ;
- +1 QUIT $PIECE($GET(^BPST(BP59,0)),U,8)\1
- +2 ;
- +3 ;/**
- +4 ;Input:
- +5 ; BP59 - pointer to file #9002313.59
- +6 ;Output:
- +7 ;ECME pharmacy division (9002313.56)
- DIVIS(BP59) ;
- +1 QUIT $PIECE($GET(^BPST(BP59,1)),U,7)
- +2 ;
- +3 ;/**
- +4 ;Input:
- +5 ; BP59 - pointer to file #9002313.59
- +6 ;Output:
- +7 ;patient's DFN (file #2)
- GETPATID(BP59) ;
- +1 QUIT $PIECE($GET(^BPST(BP59,0)),U,6)
- +2 ;
- +3 ;return RX status as ACT/DIS/etc
- RXST(BP59) ;
- +1 NEW BPRXREF
- +2 SET BPRXREF=$$RXREF^BPSSCRU2(BP59)
- +3 ;display status ONLY if the refill is the most recent
- +4 ;otherwise display blanks (three spaces for sorting purposes)
- +5 IF +$PIECE(BPRXREF,U,2)'=(+$$LSTRFL^PSOBPSU1(+$PIECE(BPRXREF,U,1)))
- QUIT "**"
- +6 QUIT $$RXSTANAM($$RXSTATUS(+$PIECE(BPRXREF,U,1)))
- +7 ;/**
- +8 ;RX status
- +9 ;Input
- +10 ; RXNUM:
- +11 ; ien of file #52 (if MODE=0)
- +12 ; or RX number (if MODE=1)
- +13 ;----------
- +14 ;Output:
- +15 ; 0 if not found
- +16 ; status set#
- RXSTATUS(RXNUM) ;*/
- +1 NEW BPRET
- +2 SET BPRET=$$RXAPI1^BPSUTIL1(RXNUM,100,"I")
- +3 IF BPRET=""
- QUIT -1
- +4 QUIT BPRET
- +5 ;/**
- +6 ;if RX "valid"
- RXACTIVE(BPRXSTAT) ;*/
- +1 ; 0 not valid
- +2 ; 1 valid (i.e. ACTIVE/NON-VERIFIED/REFILL/HOLD/DRUG INTERACTIONS/SUSPENDED)
- +3 ; -1 doesn't exist
- +4 ;active
- if BPRXSTAT<6
- QUIT 1
- +5 ;/**
- +6 ;RX status text
- RXSTANAM(BPRXSTAT) ;*/
- +1 ; ACTIVE;
- if BPRXSTAT=0
- QUIT "AC"
- +2 ; NON-VERIFIED;
- if BPRXSTAT=1
- QUIT "NV"
- +3 ; HOLD;
- if BPRXSTAT=3
- QUIT "HL"
- +4 ; SUSPENDED;
- if BPRXSTAT=5
- QUIT "SU"
- +5 ; EXPIRED;
- if BPRXSTAT=11
- QUIT "EX"
- +6 ; DISCONTINUED;
- if BPRXSTAT=12
- QUIT "DS"
- +7 ; DELETED;
- if BPRXSTAT=13
- QUIT "DL"
- +8 ; DISCONTINUED BY PROVIDER;
- if BPRXSTAT=14
- QUIT "DS"
- +9 ; DISCONTINUED (EDIT);
- if BPRXSTAT=15
- QUIT "DS"
- +10 ; PROVIDER HOLD;
- if BPRXSTAT=16
- QUIT "HL"
- +11 if BPRXSTAT=-1
- QUIT "??"
- +12 QUIT ""
- +13 ;/**
- +14 ;Input:
- +15 ; BP59 - pointer to file #9002313.59
- +16 ;Output:
- +17 ;returns:
- +18 ;>0 Released
- +19 ;0 non released
- +20 ;-1 error
- ISRXREL(BP59) ;
- +1 NEW BP1
- +2 SET BP1=$$REFILINF(BP59)
- +3 if BP1<0
- QUIT -1
- +4 ; i.e. it is non-released if there is no any release date
- QUIT $PIECE(BP1,U,2)
- +5 ;
- +6 ;release status
- RL(BP59) ;
- +1 QUIT $SELECT($$ISRXREL(BP59)>0:"R",1:"N")
- +2 ;/**
- +3 ;get refill (including original refill) info by BP59
- +4 ;Input:
- +5 ; BP59 - pointer to file #9002313.59
- +6 ;Output:
- +7 ;returns:
- +8 ;on error : "-1"
- +9 ;on success : refill# ^ release date ^label print date ^ fill date ^ issue date
- REFILINF(BP59) ;*/
- +1 NEW BP1
- SET BP1=$$RXREF(BP59)
- +2 ;ptr to #52
- NEW BPRX
- SET BPRX=$PIECE(BP1,U,1)
- +3 ;ptr in its refill multiple
- NEW BPREF
- SET BPREF=$PIECE(BP1,U,2)
- +4 ;if bad data
- IF BPREF
- IF $$IFREFILL(BPRX,BPREF)=0
- QUIT -1
- +5 ;original refill
- +6 IF BPREF=0
- QUIT "0"_U_$$RXRELDT(BPRX)_U_U_$$RXFILDT(BPRX)_U_$$RXISSDT(BPRX)
- +7 ;refill's release date
- +8 IF BPREF>0
- QUIT BPREF_U_$$REFRELDT(BPRX,BPREF)_U_U_$$REFFILDT(BPRX,BPREF)_U_$$REFISSDT(BPRX,BPREF)
- +9 QUIT -1
- +10 ;
- +11 ;-Prescriptions-----------------------
- +12 ;RX issue date
- RXISSDT(BPRX) ;
- +1 QUIT +$$RXAPI1^BPSUTIL1(BPRX,1,"I")
- +2 ;
- +3 ;RX's release date
- RXRELDT(BPRX) ;
- +1 QUIT +$$RXAPI1^BPSUTIL1(BPRX,31,"I")
- +2 ;
- +3 ;RX's fill date
- RXFILDT(BPRX) ;
- +1 QUIT +$$RXAPI1^BPSUTIL1(BPRX,22,"I")
- +2 ;
- +3 ;refill's release date
- REFRELDT(BPRX,BPREF) ;
- +1 QUIT +$$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,17,"I")
- +2 ;
- +3 ;refill's refill date
- REFFILDT(BPRX,BPREF) ;
- +1 QUIT $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I")
- +2 ;
- +3 ;refill's issue date
- REFISSDT(BPRX,BPREF) ;
- +1 QUIT $$REFDISDT(BPRX,BPREF)
- +2 ;
- +3 ;refill's dispense date
- REFDISDT(BPRX,BPREF) ;
- +1 QUIT $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,10.1,"I")
- +2 ;
- +3 ;if refill exists
- IFREFILL(BPRX,BPREF) ;
- +1 QUIT $$RXSUBF1^BPSUTIL1(BPRX,52,52.1,BPREF,.01,"I")'=""
- +2 ;/**
- +3 ;input
- +4 ;ptr to 9002313.59
- +5 ;output :
- +6 ; BB - back billing
- +7 ; P2 - PRO Option
- +8 ; RS - ECME user screen resubmission (BPS*1*20)
- +9 ; RT - all other values in (#1201) RX ACTION field on 9002313.59
- RTBB(BP59) ;*/
- +1 NEW BPTRBB
- +2 SET BPTRBB=$PIECE($GET(^BPST(BP59,12)),U)
- +3 IF BPTRBB=""
- QUIT "**"
- +4 IF BPTRBB="BB"
- QUIT "BB"
- +5 IF BPTRBB="P2"
- QUIT "P2"
- +6 IF BPTRBB="P2S"
- QUIT "P2"
- +7 ; ECME user screen resubmit (BPS*1*20)
- IF BPTRBB="ERES"
- QUIT "RS"
- +8 ; ECME user screen resubmit/without reversal (BPS*1*20)
- IF BPTRBB="ERWV"
- QUIT "RS"
- +9 ; ECME user screen resubmit TRI/CVA non-billable (BPS*1*20)
- IF BPTRBB="ERNB"
- QUIT "RS"
- +10 QUIT "RT"
- +11 ;
- +12 ;------------ patient's name
- PATNAME(BPDFN) ;
- +1 QUIT $EXTRACT($PIECE($GET(^DPT(BPDFN,0)),U),1,15)
- +2 ;
- SSN4(DFN) ;last 4 SSN
- +1 NEW X
- +2 SET X=$PIECE($GET(^DPT(DFN,0)),U,9)
- +3 QUIT "("_$EXTRACT(X,$LENGTH(X)-3,$LENGTH(X))_")"
- +4 ;
- +5 ;get drug generic name
- DRGNAM(BP50) ;
- +1 ;BP50 - ptr to #50
- +2 QUIT $EXTRACT($$DRUGDIE^BPSUTIL1(BP50,.01,"E"),1,35)
- +3 ;get drug
- GETDRUG(BP52) ;
- +1 ;return value:
- +2 ; 0 - unknown
- +3 ; n - ptr to DRUG file #50
- +4 QUIT +$$RXAPI1^BPSUTIL1(BP52,6,"I")
- +5 ;
- GETDRG59(BP59) ;
- +1 NEW BPX
- +2 SET BPX=$$RXREF(BP59)
- +3 QUIT $$GETDRUG(+BPX)
- +4 ;
- +5 ;
- +6 ;review %% for each of claims in the array
- +7 ;and calculate "overall" "done" status
- +8 ;input:
- +9 ; BPARR59 - array of ptr to #9002313.59
- +10 ;output:
- +11 ; status
- FINISHST(BPARR59) ;
- +1 NEW BPFIN,BP59
- +2 SET BPFIN=1
- SET BP59=0
- +3 FOR
- SET BP59=$ORDER(BPARR59(BP59))
- if +BP59=0
- QUIT
- Begin DoDot:1
- +4 IF $$PRCNTG^BPSSCRU3(BP59)<99
- SET BPFIN=0
- End DoDot:1
- if BPFIN=0
- QUIT
- +5 IF BPFIN=1
- QUIT "**FINISHED**"
- +6 QUIT ""
- +7 ;
- +8 ;
- +9 ;BPRX - ptr to #52
- RXNUM(BPRX) ;
- +1 QUIT $$RXAPI1^BPSUTIL1(BPRX,.01,"E")_$SELECT(+$$RXAPI1^BPSUTIL1(BPRX,105,"I"):"$",1:"")
- +2 ;
- +3 ;/**
- +4 ;get NDC
- +5 ;input
- +6 ;BPRX - ptr to #52
- +7 ;BPREF - refill # (0,1,2,3...)
- NDC(BPRX,BPREF) ;*/
- +1 NEW X
- +2 ;remove dashes
- SET X=$TRANSLATE($$GETNDC^PSONDCUT(BPRX,BPREF),"-","")
- +3 QUIT X
- +4 ;
- DRGNAME(BP59) ;drug name BP59 -ptr to .59 file
- +1 NEW BPRX
- +2 ;ptr to RX node in #52
- SET BPRX=+$PIECE($GET(^BPST(BP59,1)),U,11)
- +3 QUIT $EXTRACT($$DRGNAM($$GETDRUG(BPRX)),1,23)
- +4 ;
- +5 ;is the number even?
- +6 ;1-yes
- +7 ;0 -no
- ISEVEN(BPNUM) ;
- +1 QUIT ((BPNUM/2)-(BPNUM\2))=0
- +2 ;
- +3 ;BPSTR - string to format
- +4 ;BPSMLEN - max lenght
- +5 ;BPSCHR - char to add
- +6 ;BPSLFT - 1 - add from the left, 0 - from the right
- FORMAT(BPSTR,BPSMLEN,BPSCHR,BPSLFT) ;
- +1 NEW LN
- SET LN=$LENGTH(BPSTR)
- +2 NEW ZZ
- SET ZZ=""
- +3 IF LN=BPSMLEN
- QUIT BPSTR
- +4 IF LN>BPSMLEN
- if BPSLFT
- QUIT $EXTRACT(BPSTR,LN-BPSMLEN+1,9999)
- QUIT $EXTRACT(BPSTR,1,BPSMLEN)
- +5 SET $PIECE(ZZ,BPSCHR,BPSMLEN-LN+1)=""
- +6 if BPSLFT
- QUIT ZZ_BPSTR
- +7 QUIT BPSTR_ZZ
- +8 ;
- +9 ;/**
- +10 ;BP59 - ptr to 9002313.59
- +11 ;output :
- +12 ;ECME number from 9002313.02
- +13 ; 7 or 12 digits of the prescription IEN file 52
- +14 ; or 12 spaces
- +1 NEW BPST0,BPST4,PC,PF,PR,X
- +2 SET BPST0=$GET(^BPST(BP59,0))
- SET PC=$PIECE(BPST0,U,4)
- SET PF=$PIECE(BPST0,U,9)
- +3 SET BPST4=$GET(^BPST(BP59,4))
- SET PR=$PIECE(BPST4,U,1)
- +4 ;This is a reversal
- IF PR]""
- SET PC=PR
- +5 IF PC=""!(PF="")
- QUIT $$FORMAT("",12," ",1)
- +6 SET X=$PIECE($GET(^BPSC(PC,400,PF,400)),U,2)
- +7 IF X=""
- QUIT $$FORMAT(X,12," ",1)
- +8 QUIT $EXTRACT(X,3,14)