BPSSCR04 ;BHAM ISC/SS - USER SCREEN ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,5,11,20**;JUN 2004;Build 27
;;Per VA Directive 6402, 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/P2/RT/RS)
;'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,1) ; BPS*1*20 - also include possible non-billable pseudo-reject codes
. . 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, P2-PRO option, RS-ECME user screen resubmission)
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSSCR04 9605 printed Apr 09, 2024@20:56:55 Page 2
BPSSCR04 ;BHAM ISC/SS - USER SCREEN ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,11,20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;USER SCREEN
+4 QUIT
+5 ;input:
+6 ;BPTMP - TMP global to store data (example : $NA(^TMP($J,"BPSSCR")))
+7 ;BPARR - array with user profile information
COLLECT(BPTMP,BPARR) ;
+1 NEW BPBDT,BPEDT,BPSORT
+2 ;start date
SET BPBDT=BPARR("BDT")
+3 ;end date
SET BPEDT=BPARR("EDT")
+4 ;sort type - see SORTIT()
+5 SET BPSORT=$GET(BPARR(1.12))
+6 ;default
if BPSORT=""
SET BPSORT="T"
+7 ;kill TMP
+8 ;look for claims in 3 files
+9 ;temporary TMP file
+10 NEW BPTMP1
SET BPTMP1=$NAME(@BPTMP@("PRE59"))
+11 NEW BPTMP2
SET BPTMP2=$NAME(@BPTMP@("FILE59"))
+12 KILL @BPTMP1
+13 KILL @BPTMP2
+14 ;
+15 DO LOOK02(BPBDT,BPEDT,BPTMP1,BPSORT)
+16 DO LOOK57(BPBDT,BPEDT,BPTMP1,BPSORT)
+17 DO LOOK59(BPBDT,BPEDT,BPTMP1,BPSORT)
+18 ;remove all claims that don't match filter criteria
+19 DO FILTRALL^BPSSCR03(BPTMP1,BPTMP2,.BPARR)
+20 ;preliminary sorting for "T" sorting type
+21 IF BPSORT="T"
DO TRDFNALL^BPSSCR03(BPTMP)
+22 ;final sorting
+23 DO SORTIT(BPTMP,BPSORT)
+24 KILL @BPTMP1
+25 KILL @BPTMP2
+26 QUIT
+27 ;Input:
+28 ;BPTMP - TMP global to store data (example : $NA(^TMP($J,"BPSSCR")))
+29 ;BPSORT:
+30 ;'T' FOR TRANSACTION DATE
+31 ;'D' FOR DIVISION (ECME pharmacy)
+32 ;'I' FOR INSURANCE
+33 ;'C' FOR REJECT CODE
+34 ;'P' FOR PATIENT NAME
+35 ;'N' FOR DRUG NAME
+36 ;'B' FOR BILL TYPE (BB/P2/RT/RS)
+37 ;'L' FOR FILL LOCATION (Windows/Mail/CMOP)
+38 ;'R' FOR RELEASED/NON-RELEASED RX
+39 ;'A' FOR ACTIVE/DISCONTINUED RX
+40 ;sort it and prepare the TMP for the user screen
SORTIT(BPTMP,BPSORT) ;*/
+1 ;S BP59=+$G(^TMP($J,"BPSSCR","SRT",BPSRT))
+2 ;BPSORT:
+3 ;TRANSACTION DATE - the last time when the record
+4 ;in the file #9002313.59 -- BPS TRANSACTION FILE has been updated
+5 ;F S X=$O(@BPTMP@("SRT",BPSRT))
+6 KILL @BPTMP@("SORT")
+7 NEW BPSRTVAL,BPTRDT,BP59,BPDFN,BPIEN,BPIENNM
+8 SET BP59=0
+9 ;by transaction date -- sort by the patient/insurance combinations,
+10 ;which might have more than one claims.
+11 ;- the first on the top will be the one which has the claim(s) with the
+12 ; most recent date (other claims in this group can have any other date)
+13 IF BPSORT="T"
Begin DoDot:1
+14 ;1st step
DO MKPATINS(BPTMP)
+15 ;2nd step
DO MKTRSORT(BPTMP)
End DoDot:1
+16 ;by patient name (and his/her insurances)
+17 IF BPSORT="P"
Begin DoDot:1
+18 ;1st step
DO MKNAMINS(BPTMP)
+19 ;2nd step
DO MKPTSORT(BPTMP)
End DoDot:1
+20 ;by insurance
+21 ;(the name will be shortened up to 10 chars and its
+22 ;IEN is added to make the string unique)
+23 IF BPSORT="I"
Begin DoDot:1
+24 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+25 SET BPIEN=$$GETINSUR^BPSSCRU2(+BP59)
+26 SET BPIENNM=$SELECT(+BPIEN>0:$EXTRACT($PIECE(BPIEN,U,2),1,10)_U_(+BPIEN),1:"0")
+27 DO SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
End DoDot:2
End DoDot:1
+28 ;by division
+29 ;(the name will be shortened up to 10 chars and its
+30 ;IEN is added to make the string unique)
+31 IF BPSORT="D"
Begin DoDot:1
+32 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+33 SET BPIEN=+$$DIVIS^BPSSCRU2(+BP59)
+34 SET BPIENNM=$SELECT(BPIEN>0:$EXTRACT($$DIVNAME^BPSSCRDS(BPIEN),1,10)_U_(BPIEN),1:"0")
+35 DO SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
End DoDot:2
End DoDot:1
+36 ;by reject code
+37 ;the same claim can be listed more than once (under different reject code
+38 ;sections) because each claim may have more than one reject code.
+39 IF BPSORT="C"
Begin DoDot:1
+40 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+41 NEW BPRJCDS,BPRJ
+42 ; BPS*1*20 - also include possible non-billable pseudo-reject codes
DO REJCODES^BPSSCRU3(+BP59,.BPRJCDS,1)
+43 SET BPRJ=""
+44 FOR
SET BPRJ=$ORDER(BPRJCDS(BPRJ))
if BPRJ=""
QUIT
Begin DoDot:3
+45 DO SETSORT(BPTMP,BPSORT,BPRJ,BP59)
End DoDot:3
End DoDot:2
End DoDot:1
+46 ;by drug names
+47 ;(the name will be shortened upto 10 chars and its
+48 ;IEN is added to make the string unique)
+49 IF BPSORT="N"
Begin DoDot:1
+50 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+51 SET BPIEN=+$$GETDRG59^BPSSCRU2(+BP59)
+52 SET BPIENNM=$SELECT(BPIEN>0:$EXTRACT($$DRGNAM^BPSSCRU2(BPIEN),1,10)_U_(BPIEN),1:"0")
+53 DO SETSORT(BPTMP,BPSORT,BPIENNM,BP59)
End DoDot:2
End DoDot:1
+54 ;by claim origination type (BB-backbilling, RT-realtime, P2-PRO option, RS-ECME user screen resubmission)
+55 IF BPSORT="B"
Begin DoDot:1
+56 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+57 DO SETSORT(BPTMP,BPSORT,$$RTBB^BPSSCRU2(+BP59),BP59)
End DoDot:2
End DoDot:1
+58 ;by filling location
+59 ;M-MAIL/W-WINDOW/C-CMOP
+60 IF BPSORT="L"
Begin DoDot:1
+61 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+62 DO SETSORT(BPTMP,BPSORT,$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(+BP59)),BP59)
End DoDot:2
End DoDot:1
+63 ;by released (1) /non released (0)
+64 IF BPSORT="R"
Begin DoDot:1
+65 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+66 DO SETSORT(BPTMP,BPSORT,$$ISRXREL^BPSSCRU2(+BP59),BP59)
End DoDot:2
End DoDot:1
+67 ;by status of the fill ACT-active/DIS-discontinued/SUS-suspended/etc
+68 IF BPSORT="A"
Begin DoDot:1
+69 FOR
SET BP59=$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:2
+70 DO SETSORT(BPTMP,BPSORT,$$RXST^BPSSCRU2(+BP59),BP59)
End DoDot:2
End DoDot:1
+71 ;
+72 ;K @BPTMP@("FILE59")
+73 QUIT
+74 ;set SORT node
SETSORT(BPTMP,BPSORT,BPSRTVAL,BP59) ;*/
+1 if $LENGTH(BPSRTVAL)>0
SET @BPTMP@("SORT",BPSORT,BPSRTVAL,BP59)=""
+2 QUIT
+3 ;first look at ^BPSC (#9002313.02) for fill/refill x-ref
+4 ; since #9002313.57 is not created at the time of refill
+5 ; and since #9002313.59 has the last update date, which can be any kind of date (released/reversal/etc)
+6 ;BPBEGDT - start date
+7 ;BPENDDT - end date
+8 ;BPTMP - tmp global for items found
+9 ;BPSORT - sort type (see COLLECT^BPSSCR04)
LOOK02(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
+1 NEW BP02,BPENDDT1,BPLDT02,BP59
+2 SET BP59=0
+3 SET BPLDT02=$$FM2YMD(BPBEGDT-0.00001)
+4 SET BPENDDT1=$$FM2YMD(BPENDDT)
+5 IF BPLDT02=""
SET BPLDT02=0
+6 IF BPENDDT1=""
SET BPENDDT1=99999999
+7 FOR
SET BPLDT02=+$ORDER(^BPSC("AF",BPLDT02))
if BPLDT02=0!(BPLDT02>BPENDDT1)
QUIT
Begin DoDot:1
+8 SET BP02=0
FOR
SET BP02=$ORDER(^BPSC("AF",BPLDT02,BP02))
if +BP02=0
QUIT
Begin DoDot:2
+9 SET BP59=+$ORDER(^BPST("AE",BP02,0))
+10 if BP59=0
QUIT
+11 IF $DATA(@BPTMP@(BP59))
QUIT
+12 SET @BPTMP@(BP59)=$$YMD2FM(BPLDT02)_"^02"
End DoDot:2
End DoDot:1
+13 QUIT
+14 ; finds claims in #9002313.57 for given date frame
+15 ;#9002313.59 has only one entry per claim with, which has a date
+16 ; of the latest update for the claim
+17 ;#9002313.57 has more than one entries per claim and keep all
+18 ; changes made the claim
+19 ;so we have to go thru #9002313.57 to find the earliest date
+20 ;related to the claim to check it against BPBEGDT
+21 ;BPBEGDT - start date
+22 ;BPENDDT - end date
+23 ;BPTMP - tmp global for items found
+24 ;BPSORT - sort type (see COLLECT^BPSSCR04)
LOOK57(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
+1 NEW BPLDT57,BP57,BP59
+2 SET BPLDT57=BPBEGDT-0.00001
+3 FOR
SET BPLDT57=+$ORDER(^BPSTL("AH",BPLDT57))
if BPLDT57=0!(BPLDT57>BPENDDT)
QUIT
Begin DoDot:1
+4 SET BP57=0
FOR
SET BP57=$ORDER(^BPSTL("AH",BPLDT57,BP57))
if +BP57=0
QUIT
Begin DoDot:2
+5 SET BP59=+$GET(^BPSTL(BP57,0))
+6 ;don't create an entry if the claim is already there
IF $DATA(@BPTMP@(BP59))
QUIT
+7 SET @BPTMP@(BP59)=(BPLDT57\1)_"^57-"
End DoDot:2
End DoDot:1
+8 QUIT
+9 ; finds claims in #9002313.59 for given date frame
+10 ;#9002313.59 has only one entry per claim with, which has a date
+11 ; of the latest update for the claim
+12 ;#9002313.57 has more than one entries per claim and keep all
+13 ; changes made the claim
+14 ;so we have to go thru #9002313.57 to find the earliest date
+15 ;related to the claim to check it against BPBEGDT
+16 ;BPBEGDT - start date
+17 ;BPENDDT - end date
+18 ;BPTMP - tmp global for items found
+19 ;BPSORT - sort type (see COLLECT^BPSSCR04)
LOOK59(BPBEGDT,BPENDDT,BPTMP,BPSORT) ;
+1 NEW BPLDT59,BP59
+2 SET BPLDT59=BPBEGDT-0.00001
+3 FOR
SET BPLDT59=+$ORDER(^BPST("AH",BPLDT59))
if BPLDT59=0!(BPLDT59>BPENDDT)
QUIT
Begin DoDot:1
+4 SET BP59=0
FOR
SET BP59=$ORDER(^BPST("AH",BPLDT59,BP59))
if +BP59=0
QUIT
Begin DoDot:2
+5 ;don't create an entry if the claim is already there
IF $DATA(@BPTMP@(BP59))
QUIT
+6 SET @BPTMP@(BP59)=(BPLDT59\1)_"^59-"
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
YMD2FM(BPYMD) ;convert YYYYDDMM to FM date
+1 QUIT (($EXTRACT(BPYMD,1,4))-1700)_$EXTRACT(BPYMD,5,8)
+2 ;
FM2YMD(BPFMDT) ;convert FM date to YYYYMMDD
+1 NEW Y,Y1
+2 SET Y=$EXTRACT(BPFMDT,2,3)
SET Y1=$EXTRACT(BPFMDT,1,1)
SET Y=$SELECT(Y1=3:"20"_Y,Y1=2:"19"_Y,1:"")
+3 if Y
QUIT Y_$EXTRACT(BPFMDT,4,7)
+4 QUIT ""
+5 ;make PATIENT -INSURANCE intermediate SORTING
+6 ;global for transaction and patient sortings (1st pass)
+7 ;example:
+8 ;@BPTMP@("SORT","PI",BPDFN,BPINS,BP59)=""
MKPATINS(BPTMP) ;
+1 NEW BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
+2 SET BP59=0
+3 FOR
SET BP59=+$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:1
+4 SET BPDFN=+$$GETPATID^BPSSCRU2(BP59)
+5 if BPDFN=0
QUIT
+6 SET BPINS=+$$GETINSUR^BPSSCRU2(BP59)
+7 SET @BPTMP@("SORT","PI",BPDFN,BPINS,BP59)=""
End DoDot:1
+8 QUIT
+9 ;make PATIENT NAME -INSURANCE intermediate SORTING
+10 ;global for transaction and patient sortings (1st pass)
+11 ;example:
+12 ;@BPTMP@("SORT","PNI",BPDFN,BPINS,BP59)=""
MKNAMINS(BPTMP) ;
+1 NEW BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
+2 SET BP59=0
+3 FOR
SET BP59=+$ORDER(@BPTMP@("FILE59",BP59))
if +BP59=0
QUIT
Begin DoDot:1
+4 SET BPDFN=+$$GETPATID^BPSSCRU2(BP59)
+5 if BPDFN=0
QUIT
+6 SET BPINS=+$$GETINSUR^BPSSCRU2(BP59)
+7 SET @BPTMP@("SORT","PNI",$EXTRACT($$PATNAME^BPSSCRU2(BPDFN),1,20)_BPDFN,BPINS,BP59)=""
End DoDot:1
+8 QUIT
+9 ;Transaction type sorting - the 2nd pass
+10 ;is called after MKPATINS
MKTRSORT(BPTMP) ;
+1 NEW BPSRTVAL,BPTRDT,BP59,BPDFN,BPINS
+2 SET BPTRDT=-99999999
SET BPSRTVAL=0
+3 FOR
SET BPTRDT=$ORDER(@BPTMP@("TRDTDFN",BPTRDT))
if +BPTRDT=0
QUIT
Begin DoDot:1
+4 SET BPDFN=0
+5 FOR
SET BPDFN=$ORDER(@BPTMP@("TRDTDFN",BPTRDT,BPDFN))
if +BPDFN=0
QUIT
Begin DoDot:2
+6 SET BPINS=""
+7 FOR
SET BPINS=$ORDER(@BPTMP@("TRDTDFN",BPTRDT,BPDFN,BPINS))
if BPINS=""
QUIT
Begin DoDot:3
+8 SET BPSRTVAL=BPSRTVAL+1
SET BPINS=+BPINS
+9 SET BP59=0
+10 FOR
SET BP59=$ORDER(@BPTMP@("SORT","PI",BPDFN,BPINS,BP59))
if +BP59=0
QUIT
Begin DoDot:4
+11 DO SETSORT(BPTMP,"T",BPSRTVAL,BP59)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;Patient type sorting - the 2nd pass
+14 ;is called after MKPATINS
MKPTSORT(BPTMP) ;
+1 NEW BPSRTVAL,BPTRDT,BP59,BPPATNAM,BPINS
+2 SET BPPATNAM=""
SET BPSRTVAL=0
+3 FOR
SET BPPATNAM=$ORDER(@BPTMP@("SORT","PNI",BPPATNAM))
if BPPATNAM=""
QUIT
Begin DoDot:1
+4 ;"" to handle claims without insurance (corrupted data)
SET BPINS=""
+5 FOR
SET BPINS=$ORDER(@BPTMP@("SORT","PNI",BPPATNAM,BPINS))
if BPINS=""
QUIT
Begin DoDot:2
+6 SET BPSRTVAL=BPSRTVAL+1
SET BPINS=+BPINS
+7 SET BP59=0
+8 FOR
SET BP59=$ORDER(@BPTMP@("SORT","PNI",BPPATNAM,BPINS,BP59))
if +BP59=0
QUIT
Begin DoDot:3
+9 DO SETSORT(BPTMP,"P",BPSRTVAL,BP59)
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
