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

BPSSCRU6.m

Go to the documentation of this file.
  1. BPSSCRU6 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;22-MAY-06
  1. ;;1.0;E CLAIMS MGMT ENGINE;**3,8,10,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 -
  1. ;Output:
  1. ;
  1. DISPREJ(BP59) ;
  1. I '$G(BP59) Q
  1. N BPARR,BPN,BPCNT
  1. S BPN=0
  1. D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
  1. D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0)
  1. D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0)
  1. I BPN=0 Q
  1. S BPCNT=0
  1. F S BPCNT=$O(BPARR(BPCNT)) Q:+BPCNT=0 D
  1. . W:$L(BPARR(BPCNT)) !,?6,BPARR(BPCNT)
  1. Q
  1. ;
  1. ;return Date in specified format
  1. ;BPDT - date in FileMan format
  1. ;BPMODE:
  1. ; 1- like "JUL 23, 2005"
  1. ; 2- like "JUL 23, 2005@16:03 "
  1. ; 3- MM/DD/YY
  1. FORMDATE(BPDT,BPMODE) ;
  1. N Y,BPTIME,BPHR
  1. I $G(BPDT)=0 Q ""
  1. I BPMODE=1 S Y=BPDT\1 X ^DD("DD") Q Y
  1. I BPMODE=2 S Y=BPDT X ^DD("DD") Q Y
  1. I BPMODE=3 S Y=$E(BPDT,4,5)_"/"_$E(BPDT,6,7)_"/"_$E(BPDT,2,3) Q Y
  1. Q ""
  1. ;
  1. ;Generic function to ask a date
  1. ;Input:
  1. ;BPPROMPT - prompt like "START WITH DATE: "
  1. ;BPDFLDT - default for the prompt like "TODAY" or "T" or "T-100" or 12/12/2005
  1. ;output:
  1. ; 0 - nothing
  1. ; <0 quit
  1. ; >0 fileman date
  1. ASKDATE(BPPROMPT,BPDFLDT) ;
  1. S %DT="AEX"
  1. S %DT("A")=BPPROMPT,%DT("B")=BPDFLDT
  1. D ^%DT K %DT
  1. I Y<0 Q -1
  1. Q +Y
  1. ;Release date
  1. ;RXNO - RX ien #52
  1. ;REFNO - fill number (0=original)
  1. RELDATE(RXNO,REFNO) ;
  1. I REFNO=0 Q $$RXRELDT^BPSSCRU2(+RXNO)
  1. Q $$REFRELDT^BPSSCRU2(+RXNO,REFNO)
  1. ;
  1. ;Group name/Plan name - name originally comes from file #355.3 by BPS TRANSACTION file ien
  1. PLANNAME(BP59) ;
  1. N BPPLNM
  1. S BPPLNM=$P($G(^BPST(BP59,10,1,3)),U)
  1. S:BPPLNM="" BPPLNM=$P($G(^BPST(BP59,10,1,1)),U,3)
  1. Q BPPLNM
  1. ;Insurance name - name originally comes from file #36 by BPS TRANSACTION file ien
  1. INSNAME(BP59) ;
  1. Q $P($G(^BPST(BP59,10,1,0)),U,7)
  1. ;
  1. ;Returns close reason by ien file#356.8
  1. CLREASON(BP3568) ;
  1. Q $P($G(^IBE(356.8,BP3568,0)),U)
  1. ;
  1. ;Convert YYYYMMDD to FileMan format
  1. YMD2FM(BPYMD) ;
  1. Q ($E(BPYMD,1,4)-1700)_$E(BPYMD,5,8)
  1. ;
  1. ;get DRUG ien from PRESCRIPTION file
  1. DRUGIEN(BP52,BPDFN) ;
  1. N XZ
  1. S XZ=0
  1. K ^TMP($J,"BPSDRUG")
  1. D RX^PSO52API(BPDFN,"BPSDRUG",BP52,,"")
  1. S XZ=$G(^TMP($J,"BPSDRUG",BPDFN,BP52,6))
  1. K ^TMP($J,"BPSDRUG")
  1. Q +$P(XZ,U)
  1. ;
  1. ;
  1. CONVCLID(BPCLID) ;
  1. Q $P(BPCLID,"D2",2)
  1. ;
  1. ;Return claim status
  1. COBCLST(BP59) ;
  1. N BPTXT1,BPX,BPSTATUS,BPCOBIND,BPCOB
  1. S BPCOBIND=$P(^BPST(BP59,0),U,14)
  1. S BPSCOB=$S($G(BPCOBIND)>0:$G(BPCOBIND),1:1)
  1. S BPTXT1=$S(BPSCOB=2:"s-",BPSCOB=3:"t-",1:"p-")
  1. ;
  1. ; BPS*1*20 - non-billable entry display
  1. I $$NB^BPSSCR03(BP59) D Q BPTXT1
  1. . S BPTXT1=BPTXT1_"Non-Billable"
  1. . I $$NBCL^BPSSCR03(BP59) S BPTXT1=BPTXT1_"/Closed "
  1. . I $$NBOP^BPSSCR03(BP59) S BPTXT1=BPTXT1_"/Open "
  1. . Q
  1. ;
  1. S BPX=$$CLAIMST^BPSSCRU3(BP59)
  1. S BPSTATUS=$P(BPX,U)
  1. I BPSTATUS["E REVERSAL ACCEPTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal accepted")
  1. I BPSTATUS["E REVERSAL REJECTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal rejected")
  1. I BPSTATUS["E PAYABLE" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Payable")
  1. I BPSTATUS["E REJECTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Rejected")
  1. I BPSTATUS["E UNSTRANDED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded")
  1. I BPSTATUS["E REVERSAL UNSTRANDED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded reversal")
  1. I BPSTATUS["E CAPTURED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Captured")
  1. I BPSTATUS["E DUPLICATE" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Duplicate")
  1. I BPSTATUS["E OTHER" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Other")
  1. I BPSTATUS["IN PROGRESS" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"In progress")
  1. I BPSTATUS["CORRUPT" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Corrupt")
  1. I BPSTATUS["E REVERSAL OTHER" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal Other")
  1. I BPTXT1="" S BPTXT1="Unknown status "
  1. Q BPTXT1