- 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 Jan 18, 2025@02:54:36 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