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

BPSSCRU2.m

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