BPSUSCR4 ;BHAM ISC/FLS - STRANDED SUBMISSIONS SCREEN (cont) ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,10,11**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
; COLLECT - Compile stranded submissions
; Input:
; BPARR - Date Range
; Output:
; ^TMP("BPSUSCR",$J)
; ^TMP("BPSUSCR-1",$J)
; ^TMP("BPSUSCR-2",$J)
COLLECT(BPARR) ;
N TFILE,CFILE,SDT,STATUS,IEN59,VART,LSTUDT,CD0,DATA
N RX,FILL,NAME,SSN,INSCO,DOS,SEQ,ITEM,MESSAGE
N BPIEN77,BPSTATUS,BPTYPE,STR,POS,X,RXFILL
K BPBDT,BPEDT
K ^TMP("BPSUSCR-1",$J),^TMP("BPSUSCR-2",$J),^TMP("BPSUSCR",$J)
S VALMCNT=0,TFILE=9002313.59,CFILE=9002313.02
S BPBDT=BPARR("BDT") ;start date and time
S BPEDT=BPARR("EDT") ;end date and time
;
; Loop through all statuses from 0 to 98
; Include Insurer Asleep as the retry time will be less than 29 minutes so
; they should not show up. In addition, when the prober is resent, it also
; updates the LAST UPDATE field for the other asleep transactions with the
; same payer.
S STATUS=-1
F S STATUS=$O(^BPST("AD",STATUS)) Q:STATUS>98!(STATUS="") D
. S IEN59=0
. F S IEN59=$O(^BPST("AD",STATUS,IEN59)) Q:'IEN59 D
.. S VART=$G(^BPST(IEN59,0)) Q:VART=""
.. S LSTUDT=$$GET1^DIQ(TFILE,IEN59,7,"I")
.. I LSTUDT<BPBDT!(LSTUDT>BPEDT) Q
.. S LSTUDT=$P(LSTUDT,".",1)
.. I LSTUDT="" Q
.. S BPTYPE=$P(VART,"^",15)
.. S BPTYPE=$S(BPTYPE="C":1,BPTYPE="U":2,BPTYPE="E":3,1:4)
.. S RX=$$GET1^DIQ(TFILE,IEN59,1.11)
.. S FILL=$$GET1^DIQ(TFILE,IEN59,9)
.. S CD0=$$GET1^DIQ(TFILE,IEN59,3,"I")
.. I CD0'="" D
... S DOS=$$HL7TFM^XLFDT($$GET1^DIQ(CFILE,CD0,401))
.. I CD0="" D
... S DOS=$P($G(^BPST(IEN59,12)),"^",2)
.. S NAME=$$GET1^DIQ(TFILE,IEN59,5,"E")
.. S SSN=""
.. I $P(VART,"^",6)]"" S SSN=$P($G(^DPT($P(VART,"^",6),0)),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN))
.. S INSCO=$P($G(^BPST(IEN59,10,1,0)),"^",7)
.. S ^TMP("BPSUSCR-1",$J,BPTYPE,LSTUDT,IEN59)=NAME_U_SSN_U_RX_U_FILL_U_DOS_U_INSCO_U_STATUS
;
; Look for stranded submissions on the BPS Request queue
D COLACTRQ^BPSUSCR2(.BPARR)
;
; Now that the data is sorted, format it and build list for display
S (SEQ,ITEM)=0
S BPTYPE="" F S BPTYPE=$O(^TMP("BPSUSCR-1",$J,BPTYPE)) Q:BPTYPE="" D
. S STR="*** "_$S(BPTYPE=1:"CLAIMS",BPTYPE=2:"REVERSALS",BPTYPE=3:"ELIGIBILITY INQUIRIES",1:"UNKNOWN")_" ***"
. S POS=41-($L(STR)/2+.5\1)
. S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(STR))=STR
. S SEQ=SEQ+1,^TMP("BPSUSCR",$J,SEQ,0)=X
. S SDT="" F S SDT=$O(^TMP("BPSUSCR-1",$J,BPTYPE,SDT)) Q:SDT="" D
.. S IEN59="" F S IEN59=$O(^TMP("BPSUSCR-1",$J,BPTYPE,SDT,IEN59)) Q:IEN59="" D
... S DATA=$G(^TMP("BPSUSCR-1",$J,BPTYPE,SDT,IEN59))
... S LSTUDT=$$FORMAT($$FMTE^XLFDT(SDT,"5Z"),10)
... S NAME=$$FORMAT($P(DATA,U,1),20)
... S SSN=$$FORMAT($P(DATA,U,2),4)
... S RXFILL=""
... I $P(DATA,U,3)!($P(DATA,U,4)'="") S RXFILL=$P(DATA,U,3)_"/"_$P(DATA,U,4)
... S RXFILL=$$FORMAT(RXFILL,15)
... S DOS=$$FMTE^XLFDT($P(DATA,U,5),"5Z")
... S INSCO=$$FORMAT($P(DATA,U,6),12)
... S BPSTATUS=+$P(DATA,U,7)
... S BPIEN77=$P(DATA,U,8)
... S SEQ=SEQ+1
... S ITEM=ITEM+1
... S ^TMP("BPSUSCR",$J,SEQ,0)=$J(ITEM,3)_" "_LSTUDT_" "_NAME_" "_SSN_" "_RXFILL_" "_DOS_" "_INSCO
... S ^TMP("BPSUSCR-2",$J,ITEM,IEN59)=BPIEN77_"^"_NAME_"^"_SDT
... S SEQ=SEQ+1
... S MESSAGE=$$STATI^BPSOSU($P(DATA,U,7))
... I $E(MESSAGE,1)="?" S MESSAGE="Unknown Status"
... S ^TMP("BPSUSCR",$J,SEQ,0)=" In Progress - "_MESSAGE
S VALMCNT=SEQ
Q
;
FORMAT(D1,LEN) ;
N OUT
S D1=$G(D1),LEN=$G(LEN)
S D1=$$NOSPACE(D1)
S OUT=$E($E(D1,1,LEN)_$J("",LEN),1,LEN)
Q OUT
;
NOSPACE(VAR) ;
N RTN,SEQ,I
S RTN=""
F I=1:1:$L(VAR," ") I $P(VAR," ",I)'="" S SEQ=$G(SEQ)+1,$P(RTN," ",SEQ)=$P(VAR," ",I)
Q RTN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSUSCR4 3807 printed Apr 09, 2024@20:58:42 Page 2
BPSUSCR4 ;BHAM ISC/FLS - STRANDED SUBMISSIONS SCREEN (cont) ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,7,10,11**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; COLLECT - Compile stranded submissions
+7 ; Input:
+8 ; BPARR - Date Range
+9 ; Output:
+10 ; ^TMP("BPSUSCR",$J)
+11 ; ^TMP("BPSUSCR-1",$J)
+12 ; ^TMP("BPSUSCR-2",$J)
COLLECT(BPARR) ;
+1 NEW TFILE,CFILE,SDT,STATUS,IEN59,VART,LSTUDT,CD0,DATA
+2 NEW RX,FILL,NAME,SSN,INSCO,DOS,SEQ,ITEM,MESSAGE
+3 NEW BPIEN77,BPSTATUS,BPTYPE,STR,POS,X,RXFILL
+4 KILL BPBDT,BPEDT
+5 KILL ^TMP("BPSUSCR-1",$JOB),^TMP("BPSUSCR-2",$JOB),^TMP("BPSUSCR",$JOB)
+6 SET VALMCNT=0
SET TFILE=9002313.59
SET CFILE=9002313.02
+7 ;start date and time
SET BPBDT=BPARR("BDT")
+8 ;end date and time
SET BPEDT=BPARR("EDT")
+9 ;
+10 ; Loop through all statuses from 0 to 98
+11 ; Include Insurer Asleep as the retry time will be less than 29 minutes so
+12 ; they should not show up. In addition, when the prober is resent, it also
+13 ; updates the LAST UPDATE field for the other asleep transactions with the
+14 ; same payer.
+15 SET STATUS=-1
+16 FOR
SET STATUS=$ORDER(^BPST("AD",STATUS))
if STATUS>98!(STATUS="")
QUIT
Begin DoDot:1
+17 SET IEN59=0
+18 FOR
SET IEN59=$ORDER(^BPST("AD",STATUS,IEN59))
if 'IEN59
QUIT
Begin DoDot:2
+19 SET VART=$GET(^BPST(IEN59,0))
if VART=""
QUIT
+20 SET LSTUDT=$$GET1^DIQ(TFILE,IEN59,7,"I")
+21 IF LSTUDT<BPBDT!(LSTUDT>BPEDT)
QUIT
+22 SET LSTUDT=$PIECE(LSTUDT,".",1)
+23 IF LSTUDT=""
QUIT
+24 SET BPTYPE=$PIECE(VART,"^",15)
+25 SET BPTYPE=$SELECT(BPTYPE="C":1,BPTYPE="U":2,BPTYPE="E":3,1:4)
+26 SET RX=$$GET1^DIQ(TFILE,IEN59,1.11)
+27 SET FILL=$$GET1^DIQ(TFILE,IEN59,9)
+28 SET CD0=$$GET1^DIQ(TFILE,IEN59,3,"I")
+29 IF CD0'=""
Begin DoDot:3
+30 SET DOS=$$HL7TFM^XLFDT($$GET1^DIQ(CFILE,CD0,401))
End DoDot:3
+31 IF CD0=""
Begin DoDot:3
+32 SET DOS=$PIECE($GET(^BPST(IEN59,12)),"^",2)
End DoDot:3
+33 SET NAME=$$GET1^DIQ(TFILE,IEN59,5,"E")
+34 SET SSN=""
+35 IF $PIECE(VART,"^",6)]""
SET SSN=$PIECE($GET(^DPT($PIECE(VART,"^",6),0)),"^",9)
SET SSN=$EXTRACT(SSN,$LENGTH(SSN)-3,$LENGTH(SSN))
+36 SET INSCO=$PIECE($GET(^BPST(IEN59,10,1,0)),"^",7)
+37 SET ^TMP("BPSUSCR-1",$JOB,BPTYPE,LSTUDT,IEN59)=NAME_U_SSN_U_RX_U_FILL_U_DOS_U_INSCO_U_STATUS
End DoDot:2
End DoDot:1
+38 ;
+39 ; Look for stranded submissions on the BPS Request queue
+40 DO COLACTRQ^BPSUSCR2(.BPARR)
+41 ;
+42 ; Now that the data is sorted, format it and build list for display
+43 SET (SEQ,ITEM)=0
+44 SET BPTYPE=""
FOR
SET BPTYPE=$ORDER(^TMP("BPSUSCR-1",$JOB,BPTYPE))
if BPTYPE=""
QUIT
Begin DoDot:1
+45 SET STR="*** "_$SELECT(BPTYPE=1:"CLAIMS",BPTYPE=2:"REVERSALS",BPTYPE=3:"ELIGIBILITY INQUIRIES",1:"UNKNOWN")_" ***"
+46 SET POS=41-($LENGTH(STR)/2+.5\1)
+47 SET X=""
SET $PIECE(X," ",81)=""
SET $EXTRACT(X,POS,POS-1+$LENGTH(STR))=STR
+48 SET SEQ=SEQ+1
SET ^TMP("BPSUSCR",$JOB,SEQ,0)=X
+49 SET SDT=""
FOR
SET SDT=$ORDER(^TMP("BPSUSCR-1",$JOB,BPTYPE,SDT))
if SDT=""
QUIT
Begin DoDot:2
+50 SET IEN59=""
FOR
SET IEN59=$ORDER(^TMP("BPSUSCR-1",$JOB,BPTYPE,SDT,IEN59))
if IEN59=""
QUIT
Begin DoDot:3
+51 SET DATA=$GET(^TMP("BPSUSCR-1",$JOB,BPTYPE,SDT,IEN59))
+52 SET LSTUDT=$$FORMAT($$FMTE^XLFDT(SDT,"5Z"),10)
+53 SET NAME=$$FORMAT($PIECE(DATA,U,1),20)
+54 SET SSN=$$FORMAT($PIECE(DATA,U,2),4)
+55 SET RXFILL=""
+56 IF $PIECE(DATA,U,3)!($PIECE(DATA,U,4)'="")
SET RXFILL=$PIECE(DATA,U,3)_"/"_$PIECE(DATA,U,4)
+57 SET RXFILL=$$FORMAT(RXFILL,15)
+58 SET DOS=$$FMTE^XLFDT($PIECE(DATA,U,5),"5Z")
+59 SET INSCO=$$FORMAT($PIECE(DATA,U,6),12)
+60 SET BPSTATUS=+$PIECE(DATA,U,7)
+61 SET BPIEN77=$PIECE(DATA,U,8)
+62 SET SEQ=SEQ+1
+63 SET ITEM=ITEM+1
+64 SET ^TMP("BPSUSCR",$JOB,SEQ,0)=$JUSTIFY(ITEM,3)_" "_LSTUDT_" "_NAME_" "_SSN_" "_RXFILL_" "_DOS_" "_INSCO
+65 SET ^TMP("BPSUSCR-2",$JOB,ITEM,IEN59)=BPIEN77_"^"_NAME_"^"_SDT
+66 SET SEQ=SEQ+1
+67 SET MESSAGE=$$STATI^BPSOSU($PIECE(DATA,U,7))
+68 IF $EXTRACT(MESSAGE,1)="?"
SET MESSAGE="Unknown Status"
+69 SET ^TMP("BPSUSCR",$JOB,SEQ,0)=" In Progress - "_MESSAGE
End DoDot:3
End DoDot:2
End DoDot:1
+70 SET VALMCNT=SEQ
+71 QUIT
+72 ;
FORMAT(D1,LEN) ;
+1 NEW OUT
+2 SET D1=$GET(D1)
SET LEN=$GET(LEN)
+3 SET D1=$$NOSPACE(D1)
+4 SET OUT=$EXTRACT($EXTRACT(D1,1,LEN)_$JUSTIFY("",LEN),1,LEN)
+5 QUIT OUT
+6 ;
NOSPACE(VAR) ;
+1 NEW RTN,SEQ,I
+2 SET RTN=""
+3 FOR I=1:1:$LENGTH(VAR," ")
IF $PIECE(VAR," ",I)'=""
SET SEQ=$GET(SEQ)+1
SET $PIECE(RTN," ",SEQ)=$PIECE(VAR," ",I)
+4 QUIT RTN
