BPSOS6M ;BHAM ISC/FCS/DRS - Print log of claim ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,8**;JUN 2004;Build 29
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; Display the BPS Log for a given BPS Transaction
Q
CLAIMLOG(IEN59) ;EP - from BPSSCRDV
;
I '$G(IEN59) Q
;
; Get Device
N POP
D ^%ZIS
I $G(POP) Q
U IO
;
; Determine if this is a terminal
N BPSCR S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
;
; Read BPS Transaction into the local variable
N REC,X,X1,X2 M REC=^BPST(IEN59)
N I F I=0:1:2 I '$D(REC(I)) S REC(I)=""
;
; Display Header
I BPSCR W @IOF
W "Pharmacy ECME Log of activity for one prescription",!
;
; Prescription and Transaction Info
W "Internal Prescription #",$P(REC(1),U,11)
W " Fill #",+$P(REC(1),U)
W !,"VA Prescription #",$$RXAPI1^BPSUTIL1(+$P(REC(1),U,11),.01)
W !,"Transaction #",IEN59
;
; Patient
W !,"Patient: "
S X=$P(REC(0),U,6) I X]"" S X=$P($G(^DPT(X,0)),U) W X
;
; Insurance
W !,"Insurance: "_$$INSNAME^BPSSCRU6(IEN59)
;
; RX Coord of Benefits
W !,"RX Coord of Benefits: "
S X=$P(REC(0),U,14) S X=$S($G(X)>0:$G(X),1:1)
W $S(X=2:"Secondary",X=3:"Tertiary",1:"Primary")
;
; Status and Response
W !!,"Status: "
S X=$P(REC(0),U,2) W X," (",$$STATI^BPSOSU(X),")"
I X=99 D DISPRESP
;
; Transaction Times
W !!,"Last started on " S X1=$P(REC(0),U,11) I X1]"" W $$DATETIME^BPSOSUD(X1)
W !,"Last activity on " S X2=$P(REC(0),U,8) I X2]"" W $$DATETIME^BPSOSUD(X2)
I X1]"",X2]"" W " Elapsed time: " W $$TIMEDIF^BPSOSUD(X1,X2)
;
; Claim and Response
W !!
S X=$P(REC(0),U,4)
I X="" W "No entry"
E W "See also entry `",X
W " in file BPS CLAIMS (#9002313.02)",!
I X]"" D
. S X=$P(REC(0),U,5)
. I X="" W " but there is no entry"
. E W " and entry `",X
. W " in file BPS RESPONSES (#9002313.03)",!
;
; Log
N STOP S STOP=0
N EXISTS S EXISTS=$$EXISTS^BPSOSL1(IEN59)
I EXISTS D Q:$G(STOP)
. W !,"Log of this claim's activity: ",!
. I BPSCR S X="" D PAUSE^VALM1 I X="^" S STOP=1 Q
. D PRINTLOG^BPSOSL1(IEN59,.STOP)
. I $G(STOP) Q
. I BPSCR D PRESSANY^BPSOSU5()
I 'EXISTS D
. W !,"There is no log for this claim's activity.",!
. I BPSCR D PRESSANY^BPSOSU5()
;
; Close Device
D ^%ZISC
Q
;
; Display response info
DISPRESP ;
N RES
S RES=$P(REC(2),U)
I RES=0 D ; good, go to the claim response and see what it says
. N RSP D RESPINFO^BPSOSQ4(IEN59,.RSP)
. W !,"Response Status-Header: ",$G(RSP("HDR"))
. W !,"Response Status-Prescription: ",$G(RSP("RSP")) ; Payable, Rejected, Captured, Duplicate
. I $G(RSP("MSG"))]"" W !?10,RSP("MSG")
. N I F I=1:1:$G(RSP("REJ",0)) W !?10,$G(RSP("REJ",I))
E D
. W !,"Result: ",RES
. I $P(REC(2),U,2)]"" W " (",$P($P(REC(2),";",1),U,2,$L(REC(2),U)),")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOS6M 2816 printed Oct 16, 2024@17:52:21 Page 2
BPSOS6M ;BHAM ISC/FCS/DRS - Print log of claim ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,8**;JUN 2004;Build 29
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Display the BPS Log for a given BPS Transaction
+5 QUIT
CLAIMLOG(IEN59) ;EP - from BPSSCRDV
+1 ;
+2 IF '$GET(IEN59)
QUIT
+3 ;
+4 ; Get Device
+5 NEW POP
+6 DO ^%ZIS
+7 IF $GET(POP)
QUIT
+8 USE IO
+9 ;
+10 ; Determine if this is a terminal
+11 NEW BPSCR
SET BPSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+12 ;
+13 ; Read BPS Transaction into the local variable
+14 NEW REC,X,X1,X2
MERGE REC=^BPST(IEN59)
+15 NEW I
FOR I=0:1:2
IF '$DATA(REC(I))
SET REC(I)=""
+16 ;
+17 ; Display Header
+18 IF BPSCR
WRITE @IOF
+19 WRITE "Pharmacy ECME Log of activity for one prescription",!
+20 ;
+21 ; Prescription and Transaction Info
+22 WRITE "Internal Prescription #",$PIECE(REC(1),U,11)
+23 WRITE " Fill #",+$PIECE(REC(1),U)
+24 WRITE !,"VA Prescription #",$$RXAPI1^BPSUTIL1(+$PIECE(REC(1),U,11),.01)
+25 WRITE !,"Transaction #",IEN59
+26 ;
+27 ; Patient
+28 WRITE !,"Patient: "
+29 SET X=$PIECE(REC(0),U,6)
IF X]""
SET X=$PIECE($GET(^DPT(X,0)),U)
WRITE X
+30 ;
+31 ; Insurance
+32 WRITE !,"Insurance: "_$$INSNAME^BPSSCRU6(IEN59)
+33 ;
+34 ; RX Coord of Benefits
+35 WRITE !,"RX Coord of Benefits: "
+36 SET X=$PIECE(REC(0),U,14)
SET X=$SELECT($GET(X)>0:$GET(X),1:1)
+37 WRITE $SELECT(X=2:"Secondary",X=3:"Tertiary",1:"Primary")
+38 ;
+39 ; Status and Response
+40 WRITE !!,"Status: "
+41 SET X=$PIECE(REC(0),U,2)
WRITE X," (",$$STATI^BPSOSU(X),")"
+42 IF X=99
DO DISPRESP
+43 ;
+44 ; Transaction Times
+45 WRITE !!,"Last started on "
SET X1=$PIECE(REC(0),U,11)
IF X1]""
WRITE $$DATETIME^BPSOSUD(X1)
+46 WRITE !,"Last activity on "
SET X2=$PIECE(REC(0),U,8)
IF X2]""
WRITE $$DATETIME^BPSOSUD(X2)
+47 IF X1]""
IF X2]""
WRITE " Elapsed time: "
WRITE $$TIMEDIF^BPSOSUD(X1,X2)
+48 ;
+49 ; Claim and Response
+50 WRITE !!
+51 SET X=$PIECE(REC(0),U,4)
+52 IF X=""
WRITE "No entry"
+53 IF '$TEST
WRITE "See also entry `",X
+54 WRITE " in file BPS CLAIMS (#9002313.02)",!
+55 IF X]""
Begin DoDot:1
+56 SET X=$PIECE(REC(0),U,5)
+57 IF X=""
WRITE " but there is no entry"
+58 IF '$TEST
WRITE " and entry `",X
+59 WRITE " in file BPS RESPONSES (#9002313.03)",!
End DoDot:1
+60 ;
+61 ; Log
+62 NEW STOP
SET STOP=0
+63 NEW EXISTS
SET EXISTS=$$EXISTS^BPSOSL1(IEN59)
+64 IF EXISTS
Begin DoDot:1
+65 WRITE !,"Log of this claim's activity: ",!
+66 IF BPSCR
SET X=""
DO PAUSE^VALM1
IF X="^"
SET STOP=1
QUIT
+67 DO PRINTLOG^BPSOSL1(IEN59,.STOP)
+68 IF $GET(STOP)
QUIT
+69 IF BPSCR
DO PRESSANY^BPSOSU5()
End DoDot:1
if $GET(STOP)
QUIT
+70 IF 'EXISTS
Begin DoDot:1
+71 WRITE !,"There is no log for this claim's activity.",!
+72 IF BPSCR
DO PRESSANY^BPSOSU5()
End DoDot:1
+73 ;
+74 ; Close Device
+75 DO ^%ZISC
+76 QUIT
+77 ;
+78 ; Display response info
DISPRESP ;
+1 NEW RES
+2 SET RES=$PIECE(REC(2),U)
+3 ; good, go to the claim response and see what it says
IF RES=0
Begin DoDot:1
+4 NEW RSP
DO RESPINFO^BPSOSQ4(IEN59,.RSP)
+5 WRITE !,"Response Status-Header: ",$GET(RSP("HDR"))
+6 ; Payable, Rejected, Captured, Duplicate
WRITE !,"Response Status-Prescription: ",$GET(RSP("RSP"))
+7 IF $GET(RSP("MSG"))]""
WRITE !?10,RSP("MSG")
+8 NEW I
FOR I=1:1:$GET(RSP("REJ",0))
WRITE !?10,$GET(RSP("REJ",I))
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 WRITE !,"Result: ",RES
+11 IF $PIECE(REC(2),U,2)]""
WRITE " (",$PIECE($PIECE(REC(2),";",1),U,2,$LENGTH(REC(2),U)),")"
End DoDot:1
+12 QUIT
