252 lines
9.0 KiB
Mathematica
252 lines
9.0 KiB
Mathematica
BPSSCR04 ;BHAM ISC/SS - USER SCREEN ;14-FEB-05
|
|
;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
|
|
;;Per VHA Directive 2004-038, this routine should not be modified.
|
|
;USER SCREEN
|
|
Q
|
|
;input:
|
|
;BPTMP - TMP global to store data (example : $NA(^TMP($J,"BPSSCR")))
|
|
;BPARR - array with user profile information
|
|
COLLECT(BPTMP,BPARR) ;
|
|
N BPBDT,BPEDT,BPSORT
|
|
S BPBDT=BPARR("BDT") ;start date
|
|
S BPEDT=BPARR("EDT") ;end date
|
|
;sort type - see SORTIT()
|
|
S BPSORT=$G(BPARR(1.12))
|
|
S:BPSORT="" BPSORT="T" ;default
|
|
;kill TMP
|
|
;look for claims in 3 files
|
|
;temporary TMP file
|
|
N BPTMP1 S BPTMP1=$NA(@BPTMP@("PRE59"))
|
|
N BPTMP2 S BPTMP2=$NA(@BPTMP@("FILE59"))
|
|
K @BPTMP1
|
|
K @BPTMP2
|
|
;
|
|
D LOOK02(BPBDT,BPEDT,BPTMP1,BPSORT)
|
|
D LOOK57(BPBDT,BPEDT,BPTMP1,BPSORT)
|
|
D LOOK59(BPBDT,BPEDT,BPTMP1,BPSORT)
|
|
;remove all claims that don't match filter criteria
|
|
D FILTRALL^BPSSCR03(BPTMP1,BPTMP2,.BPARR)
|
|
;preliminary sorting for "T" sorting type
|
|
I BPSORT="T" D TRDFNALL^BPSSCR03(BPTMP)
|
|
;final sorting
|
|
D SORTIT(BPTMP,BPSORT)
|
|
K @BPTMP1
|
|
K @BPTMP2
|
|
Q
|
|
;Input:
|
|
;BPTMP - TMP global to store data (example : $NA(^TMP($J,"BPSSCR")))
|
|
;BPSORT:
|
|
;'T' FOR TRANSACTION DATE
|
|
;'D' FOR DIVISION (ECME pharmacy)
|
|
;'I' FOR INSURANCE
|
|
;'C' FOR REJECT CODE
|
|
;'P' FOR PATIENT NAME
|
|
;'N' FOR DRUG NAME
|
|
;'B' FOR BILL TYPE (BB/RT)
|
|
;'L' FOR FILL LOCATION (Windows/Mail/CMOP)
|
|
;'R' FOR RELEASED/NON-RELEASED RX
|
|
;'A' FOR ACTIVE/DISCONTINUED RX
|
|
;sort it and prepare the TMP for the user screen
|
|
SORTIT(BPTMP,BPSORT) ;*/
|
|
;S BP59=+$G(^TMP($J,"BPSSCR","SRT",BPSRT))
|
|
;BPSORT:
|
|
;TRANSACTION DATE - the last time when the record
|
|
;in the file #9002313.59 -- BPS TRANSACTION FILE has been updated
|
|
;F S X=$O(@BPTMP@("SRT",BPSRT))
|
|
K @BPTMP@("SORT")
|
|
N BPSRTVAL,BPTRDT,BP59,BPDFN,BPIEN,BPIENNM
|
|
S BP59=0
|
|
;by transaction date -- sort by the patient/insurance combinations,
|
|
;which might have more than one claims.
|
|
;- the first on the top will be the one which has the claim(s) with the
|
|
; most recent date (other claims in this group can have any other date)
|
|
I BPSORT="T" D
|
|
. D MKPATINS(BPTMP) ;1st step
|
|
. D MKTRSORT(BPTMP) ;2nd step
|
|
;by patient name (and his/her insurances)
|
|
I BPSORT="P" D
|
|
. D MKNAMINS(BPTMP) ;1st step
|
|
. D MKPTSORT(BPTMP) ;2nd step
|
|
;by insurance
|
|
;(the name will be shortened up to 10 chars and its
|
|
;IEN is added to make the string unique)
|
|
I BPSORT="I" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . S BPIEN=$$GETINSUR^BPSSCRU2(+BP59)
|
|
. . S BPIENNM=$S(+BPIEN>0:$E($P(BPIEN,U,2),1,10)_U_(+BPIEN),1:"0")
|
|
. . D SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
|
|
;by division
|
|
;(the name will be shortened up to 10 chars and its
|
|
;IEN is added to make the string unique)
|
|
I BPSORT="D" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . S BPIEN=+$$DIVIS^BPSSCRU2(+BP59)
|
|
. . S BPIENNM=$S(BPIEN>0:$E($$DIVNAME^BPSSCRDS(BPIEN),1,10)_U_(BPIEN),1:"0")
|
|
. . D SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
|
|
;by reject code
|
|
;the same claim can be listed more than once (under different reject code
|
|
;sections) because each claim may have more than one reject code.
|
|
I BPSORT="C" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . N BPRJCDS,BPRJ
|
|
. . D REJCODES^BPSSCRU3(+BP59,.BPRJCDS)
|
|
. . S BPRJ=""
|
|
. . F S BPRJ=$O(BPRJCDS(BPRJ)) Q:BPRJ="" D
|
|
. . . D SETSORT(BPTMP,BPSORT,BPRJ,BP59)
|
|
;by drug names
|
|
;(the name will be shortened upto 10 chars and its
|
|
;IEN is added to make the string unique)
|
|
I BPSORT="N" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . S BPIEN=+$$GETDRG59^BPSSCRU2(+BP59)
|
|
. . S BPIENNM=$S(BPIEN>0:$E($$DRGNAM^BPSSCRU2(BPIEN),1,10)_U_(BPIEN),1:"0")
|
|
. . D SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
|
|
;by claim origination type (BB- backbilling, RT- realtime)
|
|
I BPSORT="B" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . D SETSORT(BPTMP,BPSORT,$$RTBB^BPSSCRU2(+BP59),BP59)
|
|
;by filling location
|
|
;M-MAIL/W-WINDOW/C-CMOP
|
|
I BPSORT="L" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . D SETSORT(BPTMP,BPSORT,$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(+BP59)),BP59)
|
|
;by released (1) /non released (0)
|
|
I BPSORT="R" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . D SETSORT(BPTMP,BPSORT,$$ISRXREL^BPSSCRU2(+BP59),BP59)
|
|
;by status of the fill ACT-active/DIS-discontinued/SUS-suspended/etc
|
|
I BPSORT="A" D
|
|
. F S BP59=$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. . D SETSORT(BPTMP,BPSORT,$$RXST^BPSSCRU2(+BP59),BP59)
|
|
;
|
|
;K @BPTMP@("FILE59")
|
|
Q
|
|
;set SORT node
|
|
SETSORT(BPTMP,BPSORT,BPSRTVAL,BP59) ;*/
|
|
S:$L(BPSRTVAL)>0 @BPTMP@("SORT",BPSORT,BPSRTVAL,BP59)=""
|
|
Q
|
|
;first look at ^BPSC (#9002313.02) for fill/refill x-ref
|
|
; since #9002313.57 is not created at the time of refill
|
|
; and since #9002313.59 has the last update date, which can be any kind of date (released/reversal/etc)
|
|
;BPBEGDT - start date
|
|
;BPENDDT - end date
|
|
;BPTMP - tmp global for items found
|
|
;BPSORT - sort type (see COLLECT^BPSSCR04)
|
|
LOOK02(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
|
|
N BP02,BPENDDT1,BPLDT02,BP59
|
|
S BP59=0
|
|
S BPLDT02=$$FM2YMD(BPBEGDT-0.00001)
|
|
S BPENDDT1=$$FM2YMD(BPENDDT)
|
|
I BPLDT02="" S BPLDT02=0
|
|
I BPENDDT1="" S BPENDDT1=99999999
|
|
F S BPLDT02=+$O(^BPSC("AF",BPLDT02)) Q:BPLDT02=0!(BPLDT02>BPENDDT1) D
|
|
. S BP02=0 F S BP02=$O(^BPSC("AF",BPLDT02,BP02)) Q:+BP02=0 D
|
|
. . S BP59=+$O(^BPST("AE",BP02,0))
|
|
. . Q:BP59=0
|
|
. . I $D(@BPTMP@(BP59)) Q
|
|
. . S @BPTMP@(BP59)=$$YMD2FM(BPLDT02)_"^02"
|
|
Q
|
|
; finds claims in #9002313.57 for given date frame
|
|
;#9002313.59 has only one entry per claim with, which has a date
|
|
; of the latest update for the claim
|
|
;#9002313.57 has more than one entries per claim and keep all
|
|
; changes made the claim
|
|
;so we have to go thru #9002313.57 to find the earliest date
|
|
;related to the claim to check it against BPBEGDT
|
|
;BPBEGDT - start date
|
|
;BPENDDT - end date
|
|
;BPTMP - tmp global for items found
|
|
;BPSORT - sort type (see COLLECT^BPSSCR04)
|
|
LOOK57(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
|
|
N BPLDT57,BP57,BP59
|
|
S BPLDT57=BPBEGDT-0.00001
|
|
F S BPLDT57=+$O(^BPSTL("AH",BPLDT57)) Q:BPLDT57=0!(BPLDT57>BPENDDT) D
|
|
. S BP57=0 F S BP57=$O(^BPSTL("AH",BPLDT57,BP57)) Q:+BP57=0 D
|
|
. . S BP59=+$G(^BPSTL(BP57,0))
|
|
. . I $D(@BPTMP@(BP59)) Q ;don't create an entry if the claim is already there
|
|
. . S @BPTMP@(BP59)=(BPLDT57\1)_"^57-"
|
|
Q
|
|
; finds claims in #9002313.59 for given date frame
|
|
;#9002313.59 has only one entry per claim with, which has a date
|
|
; of the latest update for the claim
|
|
;#9002313.57 has more than one entries per claim and keep all
|
|
; changes made the claim
|
|
;so we have to go thru #9002313.57 to find the earliest date
|
|
;related to the claim to check it against BPBEGDT
|
|
;BPBEGDT - start date
|
|
;BPENDDT - end date
|
|
;BPTMP - tmp global for items found
|
|
;BPSORT - sort type (see COLLECT^BPSSCR04)
|
|
LOOK59(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
|
|
N BPLDT59,BP59
|
|
S BPLDT59=BPBEGDT-0.00001
|
|
F S BPLDT59=+$O(^BPST("AH",BPLDT59)) Q:BPLDT59=0!(BPLDT59>BPENDDT) D
|
|
. S BP59=0 F S BP59=$O(^BPST("AH",BPLDT59,BP59)) Q:+BP59=0 D
|
|
. . I $D(@BPTMP@(BP59)) Q ;don't create an entry if the claim is already there
|
|
. . S @BPTMP@(BP59)=(BPLDT59\1)_"^59-"
|
|
Q
|
|
;
|
|
YMD2FM(BPYMD) ;convert YYYYDDMM to FM date
|
|
Q (($E(BPYMD,1,4))-1700)_$E(BPYMD,5,8)
|
|
;
|
|
FM2YMD(BPFMDT) ;convert FM date to YYYYMMDD
|
|
N Y,Y1
|
|
S Y=$E(BPFMDT,2,3),Y1=$E(BPFMDT,1,1) S Y=$S(Y1=3:"20"_Y,Y1=2:"19"_Y,1:"")
|
|
Q:Y Y_$E(BPFMDT,4,7)
|
|
Q ""
|
|
;make PATIENT -INSURANCE intermediate SORTING
|
|
;global for transaction and patient sortings (1st pass)
|
|
;example:
|
|
;@BPTMP@("SORT","PI",BPDFN,BPINS,BP59)=""
|
|
MKPATINS(BPTMP) ;
|
|
N BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
|
|
S BP59=0
|
|
F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. S BPDFN=+$$GETPATID^BPSSCRU2(BP59)
|
|
. Q:BPDFN=0
|
|
. S BPINS=+$$GETINSUR^BPSSCRU2(BP59)
|
|
. S @BPTMP@("SORT","PI",BPDFN,BPINS,BP59)=""
|
|
Q
|
|
;make PATIENT NAME -INSURANCE intermediate SORTING
|
|
;global for transaction and patient sortings (1st pass)
|
|
;example:
|
|
;@BPTMP@("SORT","PNI",BPDFN,BPINS,BP59)=""
|
|
MKNAMINS(BPTMP) ;
|
|
N BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
|
|
S BP59=0
|
|
F S BP59=+$O(@BPTMP@("FILE59",BP59)) Q:+BP59=0 D
|
|
. S BPDFN=+$$GETPATID^BPSSCRU2(BP59)
|
|
. Q:BPDFN=0
|
|
. S BPINS=+$$GETINSUR^BPSSCRU2(BP59)
|
|
. S @BPTMP@("SORT","PNI",$E($$PATNAME^BPSSCRU2(BPDFN),1,20)_BPDFN,BPINS,BP59)=""
|
|
Q
|
|
;Transaction type sorting - the 2nd pass
|
|
;is called after MKPATINS
|
|
MKTRSORT(BPTMP) ;
|
|
N BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
|
|
S BPTRDT=-99999999,BPSRTVAL=0
|
|
F S BPTRDT=$O(@BPTMP@("TRDTDFN",BPTRDT)) Q:+BPTRDT=0 D
|
|
. S BPDFN=0
|
|
. F S BPDFN=$O(@BPTMP@("TRDTDFN",BPTRDT,BPDFN)) Q:+BPDFN=0 D
|
|
. . S BPINS=""
|
|
. . F S BPINS=$O(@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINS)) Q:BPINS="" D
|
|
. . . S BPSRTVAL=BPSRTVAL+1,BPINS=+BPINS
|
|
. . . S BP59=0
|
|
. . . F S BP59=$O(@BPTMP@("SORT","PI",BPDFN,BPINS,BP59)) Q:+BP59=0 D
|
|
. . . . D SETSORT(BPTMP,"T",BPSRTVAL,BP59)
|
|
Q
|
|
;Patient type sorting - the 2nd pass
|
|
;is called after MKPATINS
|
|
MKPTSORT(BPTMP) ;
|
|
N BPSRTVAL,BPTRDT,BP59,BPPATNAM,BPINS
|
|
S BPPATNAM="",BPSRTVAL=0
|
|
F S BPPATNAM=$O(@BPTMP@("SORT","PNI",BPPATNAM)) Q:BPPATNAM="" D
|
|
. S BPINS="" ;"" to handle claims without insurance (corrupted data)
|
|
. F S BPINS=$O(@BPTMP@("SORT","PNI",BPPATNAM,BPINS)) Q:BPINS="" D
|
|
. . S BPSRTVAL=BPSRTVAL+1,BPINS=+BPINS
|
|
. . S BP59=0
|
|
. . F S BP59=$O(@BPTMP@("SORT","PNI",BPPATNAM,BPINS,BP59)) Q:+BP59=0 D
|
|
. . . D SETSORT(BPTMP,"P",BPSRTVAL,BP59)
|
|
Q
|
|
;
|