| [613] | 1 | BPSSCRU6 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;22-MAY-06
|
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**3**;JUN 2004;Build 20
|
|---|
| 3 | ;; Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;USER SCREEN
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | ;Input:
|
|---|
| 8 | ; BP59 -
|
|---|
| 9 | ;Output:
|
|---|
| 10 | ;
|
|---|
| 11 | DISPREJ(BP59) ;
|
|---|
| 12 | N BPARR,BPN,BPCNT
|
|---|
| 13 | S BPN=0
|
|---|
| 14 | ;I (BPSTATUS["E REJECTED")!(BPSTATUS["E REVERSAL REJECTED") D
|
|---|
| 15 | D GETRJCOD^BPSSCRU3(BP59,.BPARR,.BPN,74,"")
|
|---|
| 16 | D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(1000,504,BP59),74,"",0)
|
|---|
| 17 | D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(1000,526,BP59),74,"",0)
|
|---|
| 18 | D WRAPLN2^BPSSCRU5(.BPN,.BPARR,$$GETMESS^BPSSCRU3(504,0,BP59),74,"",0)
|
|---|
| 19 | I BPN=0 Q
|
|---|
| 20 | S BPCNT=0
|
|---|
| 21 | F S BPCNT=$O(BPARR(BPCNT)) Q:+BPCNT=0 D
|
|---|
| 22 | . W:$L(BPARR(BPCNT)) !,?6,BPARR(BPCNT)
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | ;return Date in specified format
|
|---|
| 26 | ;BPDT - date in FileMan format
|
|---|
| 27 | ;BPMODE:
|
|---|
| 28 | ; 1- like "JUL 23, 2005"
|
|---|
| 29 | ; 2- like "JUL 23, 2005@16:03 "
|
|---|
| 30 | ; 3- MM/DD/YY
|
|---|
| 31 | FORMDATE(BPDT,BPMODE) ;
|
|---|
| 32 | N Y,BPTIME,BPHR
|
|---|
| 33 | I $G(BPDT)=0 Q ""
|
|---|
| 34 | I BPMODE=1 S Y=BPDT\1 X ^DD("DD") Q Y
|
|---|
| 35 | I BPMODE=2 S Y=BPDT X ^DD("DD") Q Y
|
|---|
| 36 | I BPMODE=3 S Y=$E(BPDT,4,5)_"/"_$E(BPDT,6,7)_"/"_$E(BPDT,2,3) Q Y
|
|---|
| 37 | Q ""
|
|---|
| 38 | ;
|
|---|
| 39 | ;Generic function to ask a date
|
|---|
| 40 | ;Input:
|
|---|
| 41 | ;BPPROMPT - prompt like "START WITH DATE: "
|
|---|
| 42 | ;BPDFLDT - default for the prompt like "TODAY" or "T" or "T-100" or 12/12/2005
|
|---|
| 43 | ;output:
|
|---|
| 44 | ; 0 - nothing
|
|---|
| 45 | ; <0 quit
|
|---|
| 46 | ; >0 fileman date
|
|---|
| 47 | ASKDATE(BPPROMPT,BPDFLDT) ;
|
|---|
| 48 | S %DT="AEX"
|
|---|
| 49 | S %DT("A")=BPPROMPT,%DT("B")=BPDFLDT
|
|---|
| 50 | D ^%DT K %DT
|
|---|
| 51 | I Y<0 Q -1
|
|---|
| 52 | Q +Y
|
|---|
| 53 | ;Release date
|
|---|
| 54 | ;RXNO - RX ien #52
|
|---|
| 55 | ;REFNO - fill number (0=original)
|
|---|
| 56 | RELDATE(RXNO,REFNO) ;
|
|---|
| 57 | I REFNO=0 Q $$RXRELDT^BPSSCRU2(+RXNO)
|
|---|
| 58 | Q $$REFRELDT^BPSSCRU2(+RXNO,REFNO)
|
|---|
| 59 | ;
|
|---|
| 60 | ;Group name/Plan name - name originally comes from file #355.3 by BPS TRANSACTION file ien
|
|---|
| 61 | PLANNAME(BP59) ;
|
|---|
| 62 | N BPPLNM
|
|---|
| 63 | S BPPLNM=$P($G(^BPST(BP59,10,1,3)),U)
|
|---|
| 64 | S:BPPLNM="" BPPLNM=$P($G(^BPST(BP59,10,1,1)),U,3)
|
|---|
| 65 | Q BPPLNM
|
|---|
| 66 | ;Insurance name - name originally comes from file #36 by BPS TRANSACTION file ien
|
|---|
| 67 | INSNAME(BP59) ;
|
|---|
| 68 | Q $P($G(^BPST(BP59,10,1,0)),U,7)
|
|---|
| 69 | ;
|
|---|
| 70 | ;Returns close reason by ien file#356.8
|
|---|
| 71 | CLREASON(BP3568) ;
|
|---|
| 72 | Q $P($G(^IBE(356.8,BP3568,0)),U)
|
|---|
| 73 | ;
|
|---|
| 74 | ;Convert YYYYMMDD to FileMan format
|
|---|
| 75 | YMD2FM(BPYMD) ;
|
|---|
| 76 | Q ($E(BPYMD,1,4)-1700)_$E(BPYMD,5,8)
|
|---|
| 77 | ;
|
|---|
| 78 | ;get DRUG ien from PRESCRIPTION file
|
|---|
| 79 | DRUGIEN(BP52,BPDFN) ;
|
|---|
| 80 | N XZ
|
|---|
| 81 | S XZ=0
|
|---|
| 82 | K ^TMP($J,"BPSDRUG")
|
|---|
| 83 | D RX^PSO52API(BPDFN,"BPSDRUG",BP52,,"")
|
|---|
| 84 | S XZ=$G(^TMP($J,"BPSDRUG",BPDFN,BP52,6))
|
|---|
| 85 | K ^TMP($J,"BPSDRUG")
|
|---|
| 86 | Q +$P(XZ,U)
|
|---|
| 87 | ;
|
|---|
| 88 | ;
|
|---|
| 89 | CONVCLID(BPCLID) ;
|
|---|
| 90 | Q $P(BPCLID,"D2",2)
|
|---|
| 91 | ;BPSSCRU6
|
|---|
