BPSSCRU6 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;22-MAY-06
;;1.0;E CLAIMS MGMT ENGINE;**3,8,10,20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;USER SCREEN
Q
;
;Input:
; BP59 -
;Output:
;
DISPREJ(BP59) ;
I '$G(BP59) Q
N BPARR,BPN,BPCNT
S BPN=0
D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0)
D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0)
I BPN=0 Q
S BPCNT=0
F S BPCNT=$O(BPARR(BPCNT)) Q:+BPCNT=0 D
. W:$L(BPARR(BPCNT)) !,?6,BPARR(BPCNT)
Q
;
;return Date in specified format
;BPDT - date in FileMan format
;BPMODE:
; 1- like "JUL 23, 2005"
; 2- like "JUL 23, 2005@16:03 "
; 3- MM/DD/YY
FORMDATE(BPDT,BPMODE) ;
N Y,BPTIME,BPHR
I $G(BPDT)=0 Q ""
I BPMODE=1 S Y=BPDT\1 X ^DD("DD") Q Y
I BPMODE=2 S Y=BPDT X ^DD("DD") Q Y
I BPMODE=3 S Y=$E(BPDT,4,5)_"/"_$E(BPDT,6,7)_"/"_$E(BPDT,2,3) Q Y
Q ""
;
;Generic function to ask a date
;Input:
;BPPROMPT - prompt like "START WITH DATE: "
;BPDFLDT - default for the prompt like "TODAY" or "T" or "T-100" or 12/12/2005
;output:
; 0 - nothing
; <0 quit
; >0 fileman date
ASKDATE(BPPROMPT,BPDFLDT) ;
S %DT="AEX"
S %DT("A")=BPPROMPT,%DT("B")=BPDFLDT
D ^%DT K %DT
I Y<0 Q -1
Q +Y
;Release date
;RXNO - RX ien #52
;REFNO - fill number (0=original)
RELDATE(RXNO,REFNO) ;
I REFNO=0 Q $$RXRELDT^BPSSCRU2(+RXNO)
Q $$REFRELDT^BPSSCRU2(+RXNO,REFNO)
;
;Group name/Plan name - name originally comes from file #355.3 by BPS TRANSACTION file ien
PLANNAME(BP59) ;
N BPPLNM
S BPPLNM=$P($G(^BPST(BP59,10,1,3)),U)
S:BPPLNM="" BPPLNM=$P($G(^BPST(BP59,10,1,1)),U,3)
Q BPPLNM
;Insurance name - name originally comes from file #36 by BPS TRANSACTION file ien
INSNAME(BP59) ;
Q $P($G(^BPST(BP59,10,1,0)),U,7)
;
;Returns close reason by ien file#356.8
CLREASON(BP3568) ;
Q $P($G(^IBE(356.8,BP3568,0)),U)
;
;Convert YYYYMMDD to FileMan format
YMD2FM(BPYMD) ;
Q ($E(BPYMD,1,4)-1700)_$E(BPYMD,5,8)
;
;get DRUG ien from PRESCRIPTION file
DRUGIEN(BP52,BPDFN) ;
N XZ
S XZ=0
K ^TMP($J,"BPSDRUG")
D RX^PSO52API(BPDFN,"BPSDRUG",BP52,,"")
S XZ=$G(^TMP($J,"BPSDRUG",BPDFN,BP52,6))
K ^TMP($J,"BPSDRUG")
Q +$P(XZ,U)
;
;
CONVCLID(BPCLID) ;
Q $P(BPCLID,"D2",2)
;
;Return claim status
COBCLST(BP59) ;
N BPTXT1,BPX,BPSTATUS,BPCOBIND,BPCOB
S BPCOBIND=$P(^BPST(BP59,0),U,14)
S BPSCOB=$S($G(BPCOBIND)>0:$G(BPCOBIND),1:1)
S BPTXT1=$S(BPSCOB=2:"s-",BPSCOB=3:"t-",1:"p-")
;
; BPS*1*20 - non-billable entry display
I $$NB^BPSSCR03(BP59) D Q BPTXT1
. S BPTXT1=BPTXT1_"Non-Billable"
. I $$NBCL^BPSSCR03(BP59) S BPTXT1=BPTXT1_"/Closed "
. I $$NBOP^BPSSCR03(BP59) S BPTXT1=BPTXT1_"/Open "
. Q
;
S BPX=$$CLAIMST^BPSSCRU3(BP59)
S BPSTATUS=$P(BPX,U)
I BPSTATUS["E REVERSAL ACCEPTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal accepted")
I BPSTATUS["E REVERSAL REJECTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal rejected")
I BPSTATUS["E PAYABLE" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Payable")
I BPSTATUS["E REJECTED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Rejected")
I BPSTATUS["E UNSTRANDED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded")
I BPSTATUS["E REVERSAL UNSTRANDED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded reversal")
I BPSTATUS["E CAPTURED" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Captured")
I BPSTATUS["E DUPLICATE" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Duplicate")
I BPSTATUS["E OTHER" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Other")
I BPSTATUS["IN PROGRESS" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"In progress")
I BPSTATUS["CORRUPT" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Corrupt")
I BPSTATUS["E REVERSAL OTHER" S BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal Other")
I BPTXT1="" S BPTXT1="Unknown status "
Q BPTXT1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCRU6 3924 printed Dec 13, 2024@01:53:24 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;USER SCREEN
+4 QUIT
+5 ;
+6 ;Input:
+7 ; BP59 -
+8 ;Output:
+9 ;
DISPREJ(BP59) ;
+1 IF '$GET(BP59)
QUIT
+2 NEW BPARR,BPN,BPCNT
+3 SET BPN=0
+4 DO GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
+5 DO WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,BP59),74,"",0)
+6 DO WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(526,BP59),74,"",0)
+7 IF BPN=0
QUIT
+8 SET BPCNT=0
+9 FOR
SET BPCNT=$ORDER(BPARR(BPCNT))
if +BPCNT=0
QUIT
Begin DoDot:1
+10 if $LENGTH(BPARR(BPCNT))
WRITE !,?6,BPARR(BPCNT)
End DoDot:1
+11 QUIT
+12 ;
+13 ;return Date in specified format
+14 ;BPDT - date in FileMan format
+15 ;BPMODE:
+16 ; 1- like "JUL 23, 2005"
+17 ; 2- like "JUL 23, 2005@16:03 "
+18 ; 3- MM/DD/YY
FORMDATE(BPDT,BPMODE) ;
+1 NEW Y,BPTIME,BPHR
+2 IF $GET(BPDT)=0
QUIT ""
+3 IF BPMODE=1
SET Y=BPDT\1
XECUTE ^DD("DD")
QUIT Y
+4 IF BPMODE=2
SET Y=BPDT
XECUTE ^DD("DD")
QUIT Y
+5 IF BPMODE=3
SET Y=$EXTRACT(BPDT,4,5)_"/"_$EXTRACT(BPDT,6,7)_"/"_$EXTRACT(BPDT,2,3)
QUIT Y
+6 QUIT ""
+7 ;
+8 ;Generic function to ask a date
+9 ;Input:
+10 ;BPPROMPT - prompt like "START WITH DATE: "
+11 ;BPDFLDT - default for the prompt like "TODAY" or "T" or "T-100" or 12/12/2005
+12 ;output:
+13 ; 0 - nothing
+14 ; <0 quit
+15 ; >0 fileman date
ASKDATE(BPPROMPT,BPDFLDT) ;
+1 SET %DT="AEX"
+2 SET %DT("A")=BPPROMPT
SET %DT("B")=BPDFLDT
+3 DO ^%DT
KILL %DT
+4 IF Y<0
QUIT -1
+5 QUIT +Y
+6 ;Release date
+7 ;RXNO - RX ien #52
+8 ;REFNO - fill number (0=original)
RELDATE(RXNO,REFNO) ;
+1 IF REFNO=0
QUIT $$RXRELDT^BPSSCRU2(+RXNO)
+2 QUIT $$REFRELDT^BPSSCRU2(+RXNO,REFNO)
+3 ;
+4 ;Group name/Plan name - name originally comes from file #355.3 by BPS TRANSACTION file ien
PLANNAME(BP59) ;
+1 NEW BPPLNM
+2 SET BPPLNM=$PIECE($GET(^BPST(BP59,10,1,3)),U)
+3 if BPPLNM=""
SET BPPLNM=$PIECE($GET(^BPST(BP59,10,1,1)),U,3)
+4 QUIT BPPLNM
+5 ;Insurance name - name originally comes from file #36 by BPS TRANSACTION file ien
INSNAME(BP59) ;
+1 QUIT $PIECE($GET(^BPST(BP59,10,1,0)),U,7)
+2 ;
+3 ;Returns close reason by ien file#356.8
CLREASON(BP3568) ;
+1 QUIT $PIECE($GET(^IBE(356.8,BP3568,0)),U)
+2 ;
+3 ;Convert YYYYMMDD to FileMan format
YMD2FM(BPYMD) ;
+1 QUIT ($EXTRACT(BPYMD,1,4)-1700)_$EXTRACT(BPYMD,5,8)
+2 ;
+3 ;get DRUG ien from PRESCRIPTION file
DRUGIEN(BP52,BPDFN) ;
+1 NEW XZ
+2 SET XZ=0
+3 KILL ^TMP($JOB,"BPSDRUG")
+4 DO RX^PSO52API(BPDFN,"BPSDRUG",BP52,,"")
+5 SET XZ=$GET(^TMP($JOB,"BPSDRUG",BPDFN,BP52,6))
+6 KILL ^TMP($JOB,"BPSDRUG")
+7 QUIT +$PIECE(XZ,U)
+8 ;
+9 ;
CONVCLID(BPCLID) ;
+1 QUIT $PIECE(BPCLID,"D2",2)
+2 ;
+3 ;Return claim status
COBCLST(BP59) ;
+1 NEW BPTXT1,BPX,BPSTATUS,BPCOBIND,BPCOB
+2 SET BPCOBIND=$PIECE(^BPST(BP59,0),U,14)
+3 SET BPSCOB=$SELECT($GET(BPCOBIND)>0:$GET(BPCOBIND),1:1)
+4 SET BPTXT1=$SELECT(BPSCOB=2:"s-",BPSCOB=3:"t-",1:"p-")
+5 ;
+6 ; BPS*1*20 - non-billable entry display
+7 IF $$NB^BPSSCR03(BP59)
Begin DoDot:1
+8 SET BPTXT1=BPTXT1_"Non-Billable"
+9 IF $$NBCL^BPSSCR03(BP59)
SET BPTXT1=BPTXT1_"/Closed "
+10 IF $$NBOP^BPSSCR03(BP59)
SET BPTXT1=BPTXT1_"/Open "
+11 QUIT
End DoDot:1
QUIT BPTXT1
+12 ;
+13 SET BPX=$$CLAIMST^BPSSCRU3(BP59)
+14 SET BPSTATUS=$PIECE(BPX,U)
+15 IF BPSTATUS["E REVERSAL ACCEPTED"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal accepted")
+16 IF BPSTATUS["E REVERSAL REJECTED"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal rejected")
+17 IF BPSTATUS["E PAYABLE"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Payable")
+18 IF BPSTATUS["E REJECTED"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Rejected")
+19 IF BPSTATUS["E UNSTRANDED"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded")
+20 IF BPSTATUS["E REVERSAL UNSTRANDED"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Unstranded reversal")
+21 IF BPSTATUS["E CAPTURED"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Captured")
+22 IF BPSTATUS["E DUPLICATE"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Duplicate")
+23 IF BPSTATUS["E OTHER"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Other")
+24 IF BPSTATUS["IN PROGRESS"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"In progress")
+25 IF BPSTATUS["CORRUPT"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Corrupt")
+26 IF BPSTATUS["E REVERSAL OTHER"
SET BPTXT1=$$CLMCLSTX^BPSSCR03(BP59,BPTXT1_"Reversal Other")
+27 IF BPTXT1=""
SET BPTXT1="Unknown status "
+28 QUIT BPTXT1
