BPSOSRX6 ;ALB/SS - ECME REQUESTS ;02-JAN-08
;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;to change the PROCESS FLAG status of the request
; BPIEN77 - BPS REQUEST ien
; BPSTAT - new PROCESS FLAG value
; returns
; 1^the BPIEN77
; or
; 0^error message
CHNGPRFL(BPIEN77,BPSTAT) ;
I $$FILLFLDS^BPSUTIL2(9002313.77,".04",BPIEN77,BPSTAT)<1 Q "0^Cannot update field #.04 (PROCESS FLAG) in BPS REQUEST"
;update user and time
Q $$UPUSRTIM(BPIEN77,+$G(MOREDATA("USER")))
;
;to set NEXT REQUEST field
; BPIEN77 - BPS REQUEST ien
; BPNXTREQ - the NEXT REQUEST ien
; returns
; 1^the BPIEN77
; or
; 0^error message
NXTREQST(BPIEN77,BPNXTREQ) ;
I BPIEN77=BPNXTREQ Q "0^Next and current requests cannot be the same"
I $$FILLFLDS^BPSUTIL2(9002313.77,".05",BPIEN77,BPNXTREQ)<1 Q "0^Cannot update field #.05 (NEXT REQUEST) in BPS REQUEST"
;update user and time and quit (return 1^ien77 if success)
Q $$UPUSRTIM(BPIEN77,+$G(MOREDATA("USER")))
;
;any active requests for the keys? = scheduled,activated,in process,comleted but not activated yet
;KEY1 - First key of the BPS Request file
;KEY2 - Second Key of the BPS Request file
;BPCOB - COB (payer sequence)
;returns
;1 - yes
;0 -no
ACTREQS(KEY1,KEY2,BPCOB) ;
N BPZZ,BPACTRQ
S BPACTRQ=0
F BPZZ=0,1,2,3 I $G(^BPS(9002313.77,"AC",BPZZ,KEY1,KEY2))=BPCOB S BPACTRQ=1 Q:BPACTRQ=1
Q BPACTRQ
;update time and user id
;BPIEN77 - BPS REQUEST ien
;BPUSER - user's DUZ
;returns 1^BPIEN77
;or 0^error message
UPUSRTIM(BPIEN77,BPUSER) ;
I $$FILLFLDS^BPSUTIL2(9002313.77,"6.05",BPIEN77,+$$NOW^BPSOSRX())<1 Q "0^Cannot update the field #6.05 in BPS REQUEST" ;S SUBMITDT=$$NOW
I $$FILLFLDS^BPSUTIL2(9002313.77,"6.06",BPIEN77,+BPUSER)<1 Q "0^Cannot update the field #6.06 in BPS REQUEST" ;USER
Q "1^"_BPIEN77
;remove all active requests for the keys
DELACTRQ(KEY1,KEY2,IEN59) ;
N BP77
D LOG^BPSOSL(IEN59,$T(+0)_"-Deleting all active requests for keys "_KEY1_", "_KEY2)
F BPZZ=0,1,2,3 D
. S BP77=0 F S BP77=$O(^BPS(9002313.77,"AC",BPZZ,KEY1,KEY2,BP77)) Q:+BP77=0 D
.. D DELREQST^BPSOSRX4(BP77,IEN59)
Q
;Old status logic - to process claims that were submitted before Processing queue mods
OLDSTAT(RXI,RXR,QUE) ;
;
; Setup needed variables
N IEN59,SDT,A,SUBDT
I '$G(RXI) Q ""
I $G(RXR)="" Q ""
I $G(QUE)="" S QUE=1
S IEN59=$$IEN59^BPSOSRX(RXI,RXR)
S SDT=$G(^XTMP("BPSOSRX",RXI,RXR))
;
; ECME record not created
I '$D(^BPST(IEN59)) D Q A
. I QUE,SDT S A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1 Q
. I QUE,$D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)) S A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1 Q
. S A=""
;
; Loop: Get data, quit if times and status match (no change during gather)
N C,T1,T2,S1,S2 F D I T1=T2,S1=S2 Q
. S T1=$$LASTUP59^BPSOSRX(IEN59)
. S S1=$$STATUS59^BPSOSRX(IEN59)
. I S1=99 D ; completed
. . S A=$$CATEG^BPSOSUC(IEN59)
. . S C=$$RESTXT59^BPSOSRX(IEN59)
. I S1'=99 D
. . S A="IN PROGRESS"
. . S C=$$STATI^BPSOSU($S(S1="":10,1:S1))
. S T2=$$LASTUP59^BPSOSRX(IEN59)
. S S2=$$STATUS59^BPSOSRX(IEN59)
;
; If the queue parameter is set and the submit date from the queue
; follows the SUBMIT DATE/LAST UPDATE date from BPS TRANSACTION
; or the RX/fill is still on the queue, then change the response
; to IN PROGRESS^Submit Date^WAITING TO START
S SUBDT=$$SUBMIT59^BPSOSRX(IEN59)
I SUBDT="" S SUBDT=T1
I $G(QUE),SDT>SUBDT!($D(^XTMP("BPS-PROC","CLAIM",RXI,RXR)))!($D(^XTMP("BPS-PROC","UNCLAIM",RXI,RXR))) S A="IN PROGRESS",T1=SDT,S1=-1,C=$$STATI^BPSOSU(0)
;
; When finishing the reversal of a Reversal/Resubmit, display IN PROGRESS
I $P($G(^BPST(IEN59,1)),"^",12)=1,S1=99 S A="IN PROGRESS",S1=98,C=$$STATI^BPSOSU(S1)
;
; Return results
Q A_U_T1_U_$E(C,1,255-$L(A)-$L(T1)-2)_U_S1
;
;check for duplicates and determine the NEXT REQUEST
;BP77 - the current request (ien of #9002313.77)
;BPDEL=1 - delete duplicates
;BPUPDNXT=1 - update the NEXT REQUEST field of the current request after skipping (deleting) duplicates
;(Note - if BPDEL=1 then BPUPDNXT will be set to 1 to avoid "hanging" requests
;BP59 - (optional) the ien of BPS TRANSACTION file
;Returns the next request or NULL (if there is no next request)
;
; For eligibility, return the next record (if there is one)
; Do not compare types or delete duplicates.
GETNXREQ(BP77,BPDEL,BPUPDNXT,BP59) ;
N BPCUR,BPCURTYP,BPARRDEL
N BPNXT77,BPTYPNXT,BP77DEL
S BPCUR=BP77,BPCURTYP=$P($G(^BPS(9002313.77,BP77,1)),U,4)
F D Q:BPNXT77=0 Q:BPCURTYP'=BPTYPNXT!(BPCURTYP="E") S BPCUR=BPNXT77,BPCURTYP=BPTYPNXT,BPARRDEL(BPNXT77)=""
. S BPNXT77=+$P($G(^BPS(9002313.77,BPCUR,0)),U,5)
. Q:BPNXT77=0
. S BPTYPNXT=$P($G(^BPS(9002313.77,BPNXT77,1)),U,4)
;if nothing to skip then quit now
I '$O(BPARRDEL("")) Q BPNXT77
; delete duplicates
I $G(BPDEL)=1 S BP77DEL=0 F S BP77DEL=$O(BPARRDEL(BP77DEL)) Q:+BP77DEL=0 D
. I $G(BP59)>0 D LOG^BPSOSL(BP59,$T(+0)_"-Delete the duplicate request "_BP77DEL)
. D DELREQST^BPSOSRX4(BP77DEL,$G(BP59))
I $G(BPDEL)=1 S BPUPDNXT=1
I $G(BPUPDNXT)=1 D
. I $$FILLFLDS^BPSUTIL2(9002313.77,".05",BP77,BPNXT77)<1 D
. . I $G(BP59)>0 D LOG^BPSOSL(BP59,$T(+0)_"-Cannot update field #.05 (NEXT REQUEST) in BPS REQUEST")
. I $G(BP59)>0 D LOG^BPSOSL(BP59,$T(+0)_"-Update field #.05 (NEXT REQUEST) to "_BPNXT77_" in the request #"_BP77)
;return the NEXT request
Q BPNXT77
;BPSOSRX6
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSRX6 5528 printed Sep 23, 2025@19:28:17 Page 2
BPSOSRX6 ;ALB/SS - ECME REQUESTS ;02-JAN-08
+1 ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;to change the PROCESS FLAG status of the request
+5 ; BPIEN77 - BPS REQUEST ien
+6 ; BPSTAT - new PROCESS FLAG value
+7 ; returns
+8 ; 1^the BPIEN77
+9 ; or
+10 ; 0^error message
CHNGPRFL(BPIEN77,BPSTAT) ;
+1 IF $$FILLFLDS^BPSUTIL2(9002313.77,".04",BPIEN77,BPSTAT)<1
QUIT "0^Cannot update field #.04 (PROCESS FLAG) in BPS REQUEST"
+2 ;update user and time
+3 QUIT $$UPUSRTIM(BPIEN77,+$GET(MOREDATA("USER")))
+4 ;
+5 ;to set NEXT REQUEST field
+6 ; BPIEN77 - BPS REQUEST ien
+7 ; BPNXTREQ - the NEXT REQUEST ien
+8 ; returns
+9 ; 1^the BPIEN77
+10 ; or
+11 ; 0^error message
NXTREQST(BPIEN77,BPNXTREQ) ;
+1 IF BPIEN77=BPNXTREQ
QUIT "0^Next and current requests cannot be the same"
+2 IF $$FILLFLDS^BPSUTIL2(9002313.77,".05",BPIEN77,BPNXTREQ)<1
QUIT "0^Cannot update field #.05 (NEXT REQUEST) in BPS REQUEST"
+3 ;update user and time and quit (return 1^ien77 if success)
+4 QUIT $$UPUSRTIM(BPIEN77,+$GET(MOREDATA("USER")))
+5 ;
+6 ;any active requests for the keys? = scheduled,activated,in process,comleted but not activated yet
+7 ;KEY1 - First key of the BPS Request file
+8 ;KEY2 - Second Key of the BPS Request file
+9 ;BPCOB - COB (payer sequence)
+10 ;returns
+11 ;1 - yes
+12 ;0 -no
ACTREQS(KEY1,KEY2,BPCOB) ;
+1 NEW BPZZ,BPACTRQ
+2 SET BPACTRQ=0
+3 FOR BPZZ=0,1,2,3
IF $GET(^BPS(9002313.77,"AC",BPZZ,KEY1,KEY2))=BPCOB
SET BPACTRQ=1
if BPACTRQ=1
QUIT
+4 QUIT BPACTRQ
+5 ;update time and user id
+6 ;BPIEN77 - BPS REQUEST ien
+7 ;BPUSER - user's DUZ
+8 ;returns 1^BPIEN77
+9 ;or 0^error message
UPUSRTIM(BPIEN77,BPUSER) ;
+1 ;S SUBMITDT=$$NOW
IF $$FILLFLDS^BPSUTIL2(9002313.77,"6.05",BPIEN77,+$$NOW^BPSOSRX())<1
QUIT "0^Cannot update the field #6.05 in BPS REQUEST"
+2 ;USER
IF $$FILLFLDS^BPSUTIL2(9002313.77,"6.06",BPIEN77,+BPUSER)<1
QUIT "0^Cannot update the field #6.06 in BPS REQUEST"
+3 QUIT "1^"_BPIEN77
+4 ;remove all active requests for the keys
DELACTRQ(KEY1,KEY2,IEN59) ;
+1 NEW BP77
+2 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Deleting all active requests for keys "_KEY1_", "_KEY2)
+3 FOR BPZZ=0,1,2,3
Begin DoDot:1
+4 SET BP77=0
FOR
SET BP77=$ORDER(^BPS(9002313.77,"AC",BPZZ,KEY1,KEY2,BP77))
if +BP77=0
QUIT
Begin DoDot:2
+5 DO DELREQST^BPSOSRX4(BP77,IEN59)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;Old status logic - to process claims that were submitted before Processing queue mods
OLDSTAT(RXI,RXR,QUE) ;
+1 ;
+2 ; Setup needed variables
+3 NEW IEN59,SDT,A,SUBDT
+4 IF '$GET(RXI)
QUIT ""
+5 IF $GET(RXR)=""
QUIT ""
+6 IF $GET(QUE)=""
SET QUE=1
+7 SET IEN59=$$IEN59^BPSOSRX(RXI,RXR)
+8 SET SDT=$GET(^XTMP("BPSOSRX",RXI,RXR))
+9 ;
+10 ; ECME record not created
+11 IF '$DATA(^BPST(IEN59))
Begin DoDot:1
+12 IF QUE
IF SDT
SET A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1
QUIT
+13 IF QUE
IF $DATA(^XTMP("BPS-PROC","CLAIM",RXI,RXR))
SET A="IN PROGRESS"_U_SDT_U_$$STATI^BPSOSU(0)_U_-1
QUIT
+14 SET A=""
End DoDot:1
QUIT A
+15 ;
+16 ; Loop: Get data, quit if times and status match (no change during gather)
+17 NEW C,T1,T2,S1,S2
FOR
Begin DoDot:1
+18 SET T1=$$LASTUP59^BPSOSRX(IEN59)
+19 SET S1=$$STATUS59^BPSOSRX(IEN59)
+20 ; completed
IF S1=99
Begin DoDot:2
+21 SET A=$$CATEG^BPSOSUC(IEN59)
+22 SET C=$$RESTXT59^BPSOSRX(IEN59)
End DoDot:2
+23 IF S1'=99
Begin DoDot:2
+24 SET A="IN PROGRESS"
+25 SET C=$$STATI^BPSOSU($SELECT(S1="":10,1:S1))
End DoDot:2
+26 SET T2=$$LASTUP59^BPSOSRX(IEN59)
+27 SET S2=$$STATUS59^BPSOSRX(IEN59)
End DoDot:1
IF T1=T2
IF S1=S2
QUIT
+28 ;
+29 ; If the queue parameter is set and the submit date from the queue
+30 ; follows the SUBMIT DATE/LAST UPDATE date from BPS TRANSACTION
+31 ; or the RX/fill is still on the queue, then change the response
+32 ; to IN PROGRESS^Submit Date^WAITING TO START
+33 SET SUBDT=$$SUBMIT59^BPSOSRX(IEN59)
+34 IF SUBDT=""
SET SUBDT=T1
+35 IF $GET(QUE)
IF SDT>SUBDT!($DATA(^XTMP("BPS-PROC","CLAIM",RXI,RXR)))!($DATA(^XTMP("BPS-PROC","UNCLAIM",RXI,RXR)))
SET A="IN PROGRESS"
SET T1=SDT
SET S1=-1
SET C=$$STATI^BPSOSU(0)
+36 ;
+37 ; When finishing the reversal of a Reversal/Resubmit, display IN PROGRESS
+38 IF $PIECE($GET(^BPST(IEN59,1)),"^",12)=1
IF S1=99
SET A="IN PROGRESS"
SET S1=98
SET C=$$STATI^BPSOSU(S1)
+39 ;
+40 ; Return results
+41 QUIT A_U_T1_U_$EXTRACT(C,1,255-$LENGTH(A)-$LENGTH(T1)-2)_U_S1
+42 ;
+43 ;check for duplicates and determine the NEXT REQUEST
+44 ;BP77 - the current request (ien of #9002313.77)
+45 ;BPDEL=1 - delete duplicates
+46 ;BPUPDNXT=1 - update the NEXT REQUEST field of the current request after skipping (deleting) duplicates
+47 ;(Note - if BPDEL=1 then BPUPDNXT will be set to 1 to avoid "hanging" requests
+48 ;BP59 - (optional) the ien of BPS TRANSACTION file
+49 ;Returns the next request or NULL (if there is no next request)
+50 ;
+51 ; For eligibility, return the next record (if there is one)
+52 ; Do not compare types or delete duplicates.
GETNXREQ(BP77,BPDEL,BPUPDNXT,BP59) ;
+1 NEW BPCUR,BPCURTYP,BPARRDEL
+2 NEW BPNXT77,BPTYPNXT,BP77DEL
+3 SET BPCUR=BP77
SET BPCURTYP=$PIECE($GET(^BPS(9002313.77,BP77,1)),U,4)
+4 FOR
Begin DoDot:1
+5 SET BPNXT77=+$PIECE($GET(^BPS(9002313.77,BPCUR,0)),U,5)
+6 if BPNXT77=0
QUIT
+7 SET BPTYPNXT=$PIECE($GET(^BPS(9002313.77,BPNXT77,1)),U,4)
End DoDot:1
if BPNXT77=0
QUIT
if BPCURTYP'=BPTYPNXT!(BPCURTYP="E")
QUIT
SET BPCUR=BPNXT77
SET BPCURTYP=BPTYPNXT
SET BPARRDEL(BPNXT77)=""
+8 ;if nothing to skip then quit now
+9 IF '$ORDER(BPARRDEL(""))
QUIT BPNXT77
+10 ; delete duplicates
+11 IF $GET(BPDEL)=1
SET BP77DEL=0
FOR
SET BP77DEL=$ORDER(BPARRDEL(BP77DEL))
if +BP77DEL=0
QUIT
Begin DoDot:1
+12 IF $GET(BP59)>0
DO LOG^BPSOSL(BP59,$TEXT(+0)_"-Delete the duplicate request "_BP77DEL)
+13 DO DELREQST^BPSOSRX4(BP77DEL,$GET(BP59))
End DoDot:1
+14 IF $GET(BPDEL)=1
SET BPUPDNXT=1
+15 IF $GET(BPUPDNXT)=1
Begin DoDot:1
+16 IF $$FILLFLDS^BPSUTIL2(9002313.77,".05",BP77,BPNXT77)<1
Begin DoDot:2
+17 IF $GET(BP59)>0
DO LOG^BPSOSL(BP59,$TEXT(+0)_"-Cannot update field #.05 (NEXT REQUEST) in BPS REQUEST")
End DoDot:2
+18 IF $GET(BP59)>0
DO LOG^BPSOSL(BP59,$TEXT(+0)_"-Update field #.05 (NEXT REQUEST) to "_BPNXT77_" in the request #"_BP77)
End DoDot:1
+19 ;return the NEXT request
+20 QUIT BPNXT77
+21 ;BPSOSRX6
+22 ;
