BPSUSCR1 ;BHAM ISC/FLS - STRANDED SUBMISSIONS SCREEN (cont) ;10-MAR-2005
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10,11,27**;JUN 2004;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
; Fileman read of New Person file (VA(200)) supported by IA10060
; Call to MSGSTAT^HLUTIL supported by IA3098
; Call to MSGACT^HLUTIL supported by IA3098
; Call to TRIM^XLFSTR supported by IA10104
;
Q
;
; Warning message for 'Transmitting' submissions
MESSAGE() ;
W !!!,"Please be aware that if there are submissions appearing on the ECME User Screen"
W !,"with a status of 'In progress - Transmitting', then there may be a problem"
W !,"with HL7 or with system connectivity with the Austin Automation Center (AAC)."
W !,"Please contact your IRM to verify that connectivity to the AAC is working"
W !,"and the HL7 link BPS NCPDP is processing messages before using this option"
W !,"to unstrand submissions with a status of 'In progress - Transmitting'.",!
N DIR,X,Y,BPQ
S BPQ=0
S DIR(0)="YA",DIR("A")="Do you want to continue? "
S DIR("B")="NO"
D ^DIR
I Y'=1 S BPQ=1
W !!
Q BPQ
;
GETDTS(BPARR) ; Transaction dates to view.
N DIR
K DIRUT,DIROUT,DUOUT,DTOUT,Y
S DIR(0)="DA^:DT:EX",DIR("A")="FIRST TRANSACTION DATE: "
S DIR("B")="T-1"
D ^DIR
Q:$D(DUOUT)!($D(DTOUT))
S BPARR("BDT")=Y_".000001"
ENDDT ;
K DIRUT,DIROUT,DUOUT,DTOUT,Y
S DIR(0)="DA^"_$P(BPARR("BDT"),".",1)_":DT:EX",DIR("A")="LAST TRANSACTION DATE: "
S DIR("B")="T"
D ^DIR
Q:$D(DUOUT)!($D(DTOUT))
S BPARR("EDT")=$$EDATE(Y)
Q
;
EDATE(DATE) ;
N RTN,%,%H
S RTN=DATE_".235959"
D NOW^%DTC
I $P(%,".")=DATE S $P(%H,",",2)=$P(%H,",",2)-1800 D YX^%DTC S RTN=DATE_%
Q RTN
;
ALL ; Unstrand all submissions currently selected.
D FULL^VALM1
N BPSD0,SEQ,LAST,TMP,TMP2,RET
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S LAST=+$O(^TMP("BPSUSCR-2",$J,""),-1)
I LAST=0 D Q
. W !,"There are no stranded submissions in this date range to unstrand"
. K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
; Display message if there are multiple types on the queue
S TMP=$O(^TMP("BPSUSCR-1",$J,""))
I TMP S TMP2=$O(^TMP("BPSUSCR-1",$J,TMP))
I TMP2 D
. W !,"Please be aware there are multiple types of requests currently stranded."
. W !,"Are you sure you want to unstrand ALL submissions? If not, exit this"
. W !,"action and select which submissions you want to unstrand."
. W !!,"Answer NO to following prompt if you wish to SELECT the submissions to unstrand.",!
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO" D ^DIR Q:'Y
W !,"Please wait..."
S SEQ=0,RET=0
F S SEQ=$O(^TMP("BPSUSCR-2",$J,SEQ)) Q:'SEQ D
. S BPSD0=""
. F S BPSD0=$O(^TMP("BPSUSCR-2",$J,SEQ,BPSD0)) Q:'BPSD0 D
. . S X=$$UNSTRAND(BPSD0,$G(^TMP("BPSUSCR-2",$J,SEQ,BPSD0)))
. . I 'X S RET=1
. . Q
. Q
I 'RET W !,"Done"
E K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
D CLEAN^VALM10
D COLLECT^BPSUSCR4(.BPARR)
Q
;
SELECT ; Select entries from the list and run each through the unstrand function
D FULL^VALM1
N D0,I,J,VAR,BPTMPGL,PT,POP,LAST,RET
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
S LAST=+$O(^TMP("BPSUSCR-2",$J,""),-1)
I LAST=0 D Q
. W !,"There are no stranded submissions to select"
. K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
K DTOUT,DUOUT
S BPTMPGL="^TMP(""BPSUSCR"",$J)"
S VAR=""
K DIR
S DIR(0)="LO^1:"_LAST
S DIR("A")="Enter a Selection of Stranded Submissions",DIR("B")=""
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q
S VAR=Y,RET=0
F I=1:1:$L(VAR,",") S PT=$P(VAR,",",I) D
. Q:PT=""
. I PT'["-" S D0=$O(^TMP("BPSUSCR-2",$J,PT,"")) S X=$$UNSTRAND(D0,$G(^TMP("BPSUSCR-2",$J,PT,+D0))) I 'X S RET=1 Q
. F J=$P(PT,"-"):1:$P(PT,"-",2) S D0=$O(^TMP("BPSUSCR-2",$J,J,"")) S X=$$UNSTRAND(D0,$G(^TMP("BPSUSCR-2",$J,J,+D0))) I 'X S RET=1
. Q
I RET K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
D CLEAN^VALM10
D COLLECT^BPSUSCR4(.BPARR)
Q
;
PRINT ;
; Full Screen Mode
D FULL^VALM1
; Prompt for pinter
N %ZIS,POP
S %ZIS="M",%ZIS("A")="Select Printer: ",%ZIS("B")="" D ^%ZIS
I POP Q
; Use device
U IO
; Create Report
D REPORT
Q
;
REPORT ;
N SEQ,LINE,BPQ,LCNT,DATA,BPSCR
;
; Set flag for interactive device
S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
;
; Print first header
D HDR
;
; Loop through data and display
S SEQ=0,BPQ=0,DATA=0
F S SEQ=$O(^TMP("BPSUSCR",$J,SEQ)) Q:'SEQ D I BPQ Q
. S LINE=$G(^TMP("BPSUSCR",$J,SEQ,0))
. ; Check if we filled a page
. S BPQ=$$CHKP(BPSCR) I BPQ Q
. W !,$E(LINE,1,79)
. S LCNT=LCNT+1
. S DATA=1
;
; If no data, display message
I DATA=0 W !?4,"No data to display"
;
; Write FF for print devices
; Else final Press Return...
I 'BPSCR W !,@IOF
E I 'BPQ D PAUSE2
;
; Close the device and quit
D ^%ZISC
Q
;
HDR ;
; Display Header.
; LCNT is returned
N HDR,TAB
S HDR="Submissions Stranded from "_BPBDT_" through "_BPEDT
S TAB=80-$L(HDR)\2
W !!,?TAB,HDR
W !!?4,"TRANS DT",?15,"PATIENT NAME",?36,"ID",?41,"RX/FILL",?57,"DOS",?68,"INS CO"
W !,?4,"--------",?15,"------------",?36,"--",?41,"-------",?57,"---",?68,"------"
S LCNT=5
Q
;
CHKP(BPSCR) ;
; Check for End of Page
; LCNT is returned
N BPLINES
I $G(BPSCR) S BPLINES=3
E S BPLINES=1
I '$G(IOSL) Q 0
I IOSL'<(LCNT+BPLINES) Q 0
I $G(BPSCR) S BPQ=$$PAUSE I BPQ Q 1
D HDR
Q 0
;
PAUSE() ;
N X
U IO(0)
R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
I '$T!(X="^") Q 1
U IO
Q 0
;
PAUSE2 ;
N X
U IO(0)
R !,"Press RETURN to continue: ",X:DTIME
U IO
Q
;
UNSTRAND(IEN59,DATA) ;
; Unstrand a specific submission
;
; Input variables
; IEN59 - IEN of BPS TRANSACTION
; DATA - String of data delimited with caret ('^')
; Piece 1 - IEN of BPS REQUEST - If this is defined, it means that there
; was only a request record but no BPS TRANSACTION record
; Piece 2 - Patient Name
; Piece 3 - Date of Service
; Returns
; 1: Successful, 0:Unsucessful
;
N MES,BPTYPE,HL7,MES,X
; If the IEN of BPS Request file is passed in, that means that there was no transaction
; data (no 0 node) so we need to just remove the request. This will be done by UNQUEUE.
I +$G(DATA)>0 D UNQUEUE(IEN59,+DATA) Q 1
;
; Cancel the outgoing HL7 message. If it has a status of 1 (waiting in queue), cancel
; it. If the cancel fails, do not unstrand and display a message
; If it has a status of 1.5 (opening connection), do not unstrand and display a message
; Calls to HLUTIL supported by IA3098
S HL7=$P($G(^BPST(IEN59,0)),U,3),MES=""
I HL7 D I MES]"" D LOG^BPSOSL(IEN59,$T(+0)_"-"_MES) W !!,MES,!,"The transaction(s) should process normally/no further action required" Q 0
. N STAT,RESLT,NAME,DATE
. S STAT=+$$MSGSTAT^HLUTIL(HL7)
. D LOG^BPSOSL(IEN59,$T(+0)_"-Checking on whether to remove the HL7 message "_HL7_" from the HL7 queue. Status is "_STAT)
. S NAME=$$TRIM^XLFSTR($E($P(DATA,U,2),1,21)),DATE=$$DATTIM^BPSRPT1($P(DATA,U,3))
. ; If status is 1 (Waiting in Queue), cancel the queue entry
. I STAT=1 D Q
.. S RESLT=$$MSGACT^HLUTIL(HL7,1)
.. D LOG^BPSOSL(IEN59,$T(+0)_"-HL7 message cancelled - Result is "_RESLT)
.. ; If the cancel failed, set the message variable and do not unstrand
.. I RESLT=0 S MES="The HL7 message for "_NAME_" on "_DATE_" could not be cancelled"
. ; If status is 1.5 (Opening Connection), set the message variable but do not try to unstrand
. I STAT=1.5 S MES="The HL7 message for "_NAME_" on "_DATE_" is open on the HL7 queue"
;
; Set the result (error 99) and message
S BPTYPE=$P($G(^BPST(IEN59,0)),U,15)
S MES="E UNSTRANDED"
I BPTYPE="U" S MES="E REVERSAL UNSTRANDED"
I BPTYPE="E" S MES="E ELIGIBILITY UNSTRANDED"
D SETRESU^BPSOSU(IEN59,99,MES)
;
; Setting the status to 99% will call REQST99^BPSOSRX5, which will delete
; the current request and subsequent requests
D SETSTAT^BPSOSU(IEN59,99)
;
; Update the log
S MES=$T(+0)_"-Unstranded"
I $G(DUZ) S MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E") ; IA# 10060
D LOG^BPSOSL(IEN59,MES)
Q 1
;
;Remove all requests for this set of keys
UNQUEUE(IEN59,IEN77) ;
N MES,KEY1,KEY2,BPTYPE,BPRETV
I 'IEN77 Q
S KEY1=$$GET1^DIQ(9002313.77,IEN77,.01,"I")
S KEY2=$$GET1^DIQ(9002313.77,IEN77,.02,"I")
S BPTYPE=$$GET1^DIQ(9002313.77,IEN77,1.04,"I")
I BPTYPE'="E" D
. W !,"Warning! The stranded request for the prescription #"_$$GET1^DIQ(9002313.77,IEN77,1.13,"E")_" and fill "_$$GET1^DIQ(9002313.77,IEN77,1.14,"E")
. W !,"is being deleted. It might need to be submitted manually in the IB Claims"
. W !,"Tracking Edit option."
. D PRESSANY^BPSOSU5()
;
; Lock the request
D LOG^BPSOSL(IEN59,$T(+0)_"-Attempting to lock request with keys "_KEY1_", "_KEY2)
S BPRETV=$$LOCKRF^BPSOSRX(KEY1,KEY2,10,IEN59,$T(+0))
I 'BPRETV D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot lock keys") Q
;
; Set request to completed and delete any other subsequent or active requests
; Then unlock the record
D COMPLETD^BPSOSRX4(IEN77),DELALLRQ^BPSOSRX7(IEN77,IEN59),DELACTRQ^BPSOSRX6(KEY1,KEY2,IEN59)
D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0))
;
; Put message in log indicating that we have unstranded the request
S MES=$T(+0)_"-Unqueued (unstranded)"
I $G(DUZ) S MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E") ; IA# 10060
D LOG^BPSOSL(IEN59,MES)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSUSCR1 9456 printed Apr 09, 2024@20:56:29 Page 2
BPSUSCR1 ;BHAM ISC/FLS - STRANDED SUBMISSIONS SCREEN (cont) ;10-MAR-2005
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10,11,27**;JUN 2004;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Fileman read of New Person file (VA(200)) supported by IA10060
+5 ; Call to MSGSTAT^HLUTIL supported by IA3098
+6 ; Call to MSGACT^HLUTIL supported by IA3098
+7 ; Call to TRIM^XLFSTR supported by IA10104
+8 ;
+9 QUIT
+10 ;
+11 ; Warning message for 'Transmitting' submissions
MESSAGE() ;
+1 WRITE !!!,"Please be aware that if there are submissions appearing on the ECME User Screen"
+2 WRITE !,"with a status of 'In progress - Transmitting', then there may be a problem"
+3 WRITE !,"with HL7 or with system connectivity with the Austin Automation Center (AAC)."
+4 WRITE !,"Please contact your IRM to verify that connectivity to the AAC is working"
+5 WRITE !,"and the HL7 link BPS NCPDP is processing messages before using this option"
+6 WRITE !,"to unstrand submissions with a status of 'In progress - Transmitting'.",!
+7 NEW DIR,X,Y,BPQ
+8 SET BPQ=0
+9 SET DIR(0)="YA"
SET DIR("A")="Do you want to continue? "
+10 SET DIR("B")="NO"
+11 DO ^DIR
+12 IF Y'=1
SET BPQ=1
+13 WRITE !!
+14 QUIT BPQ
+15 ;
GETDTS(BPARR) ; Transaction dates to view.
+1 NEW DIR
+2 KILL DIRUT,DIROUT,DUOUT,DTOUT,Y
+3 SET DIR(0)="DA^:DT:EX"
SET DIR("A")="FIRST TRANSACTION DATE: "
+4 SET DIR("B")="T-1"
+5 DO ^DIR
+6 if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+7 SET BPARR("BDT")=Y_".000001"
ENDDT ;
+1 KILL DIRUT,DIROUT,DUOUT,DTOUT,Y
+2 SET DIR(0)="DA^"_$PIECE(BPARR("BDT"),".",1)_":DT:EX"
SET DIR("A")="LAST TRANSACTION DATE: "
+3 SET DIR("B")="T"
+4 DO ^DIR
+5 if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+6 SET BPARR("EDT")=$$EDATE(Y)
+7 QUIT
+8 ;
EDATE(DATE) ;
+1 NEW RTN,%,%H
+2 SET RTN=DATE_".235959"
+3 DO NOW^%DTC
+4 IF $PIECE(%,".")=DATE
SET $PIECE(%H,",",2)=$PIECE(%H,",",2)-1800
DO YX^%DTC
SET RTN=DATE_%
+5 QUIT RTN
+6 ;
ALL ; Unstrand all submissions currently selected.
+1 DO FULL^VALM1
+2 NEW BPSD0,SEQ,LAST,TMP,TMP2,RET
+3 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+4 SET LAST=+$ORDER(^TMP("BPSUSCR-2",$JOB,""),-1)
+5 IF LAST=0
Begin DoDot:1
+6 WRITE !,"There are no stranded submissions in this date range to unstrand"
+7 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
End DoDot:1
QUIT
+8 ; Display message if there are multiple types on the queue
+9 SET TMP=$ORDER(^TMP("BPSUSCR-1",$JOB,""))
+10 IF TMP
SET TMP2=$ORDER(^TMP("BPSUSCR-1",$JOB,TMP))
+11 IF TMP2
Begin DoDot:1
+12 WRITE !,"Please be aware there are multiple types of requests currently stranded."
+13 WRITE !,"Are you sure you want to unstrand ALL submissions? If not, exit this"
+14 WRITE !,"action and select which submissions you want to unstrand."
+15 WRITE !!,"Answer NO to following prompt if you wish to SELECT the submissions to unstrand.",!
End DoDot:1
+16 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="NO"
DO ^DIR
if 'Y
QUIT
+17 WRITE !,"Please wait..."
+18 SET SEQ=0
SET RET=0
+19 FOR
SET SEQ=$ORDER(^TMP("BPSUSCR-2",$JOB,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+20 SET BPSD0=""
+21 FOR
SET BPSD0=$ORDER(^TMP("BPSUSCR-2",$JOB,SEQ,BPSD0))
if 'BPSD0
QUIT
Begin DoDot:2
+22 SET X=$$UNSTRAND(BPSD0,$GET(^TMP("BPSUSCR-2",$JOB,SEQ,BPSD0)))
+23 IF 'X
SET RET=1
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 IF 'RET
WRITE !,"Done"
+27 IF '$TEST
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
+28 DO CLEAN^VALM10
+29 DO COLLECT^BPSUSCR4(.BPARR)
+30 QUIT
+31 ;
SELECT ; Select entries from the list and run each through the unstrand function
+1 DO FULL^VALM1
+2 NEW D0,I,J,VAR,BPTMPGL,PT,POP,LAST,RET
+3 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+4 SET LAST=+$ORDER(^TMP("BPSUSCR-2",$JOB,""),-1)
+5 IF LAST=0
Begin DoDot:1
+6 WRITE !,"There are no stranded submissions to select"
+7 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
End DoDot:1
QUIT
+8 KILL DTOUT,DUOUT
+9 SET BPTMPGL="^TMP(""BPSUSCR"",$J)"
+10 SET VAR=""
+11 KILL DIR
+12 SET DIR(0)="LO^1:"_LAST
+13 SET DIR("A")="Enter a Selection of Stranded Submissions"
SET DIR("B")=""
+14 DO ^DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+16 SET VAR=Y
SET RET=0
+17 FOR I=1:1:$LENGTH(VAR,",")
SET PT=$PIECE(VAR,",",I)
Begin DoDot:1
+18 if PT=""
QUIT
+19 IF PT'["-"
SET D0=$ORDER(^TMP("BPSUSCR-2",$JOB,PT,""))
SET X=$$UNSTRAND(D0,$GET(^TMP("BPSUSCR-2",$JOB,PT,+D0)))
IF 'X
SET RET=1
QUIT
+20 FOR J=$PIECE(PT,"-"):1:$PIECE(PT,"-",2)
SET D0=$ORDER(^TMP("BPSUSCR-2",$JOB,J,""))
SET X=$$UNSTRAND(D0,$GET(^TMP("BPSUSCR-2",$JOB,J,+D0)))
IF 'X
SET RET=1
+21 QUIT
End DoDot:1
+22 IF RET
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
DO ^DIR
+23 DO CLEAN^VALM10
+24 DO COLLECT^BPSUSCR4(.BPARR)
+25 QUIT
+26 ;
PRINT ;
+1 ; Full Screen Mode
+2 DO FULL^VALM1
+3 ; Prompt for pinter
+4 NEW %ZIS,POP
+5 SET %ZIS="M"
SET %ZIS("A")="Select Printer: "
SET %ZIS("B")=""
DO ^%ZIS
+6 IF POP
QUIT
+7 ; Use device
+8 USE IO
+9 ; Create Report
+10 DO REPORT
+11 QUIT
+12 ;
REPORT ;
+1 NEW SEQ,LINE,BPQ,LCNT,DATA,BPSCR
+2 ;
+3 ; Set flag for interactive device
+4 SET BPSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+5 ;
+6 ; Print first header
+7 DO HDR
+8 ;
+9 ; Loop through data and display
+10 SET SEQ=0
SET BPQ=0
SET DATA=0
+11 FOR
SET SEQ=$ORDER(^TMP("BPSUSCR",$JOB,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+12 SET LINE=$GET(^TMP("BPSUSCR",$JOB,SEQ,0))
+13 ; Check if we filled a page
+14 SET BPQ=$$CHKP(BPSCR)
IF BPQ
QUIT
+15 WRITE !,$EXTRACT(LINE,1,79)
+16 SET LCNT=LCNT+1
+17 SET DATA=1
End DoDot:1
IF BPQ
QUIT
+18 ;
+19 ; If no data, display message
+20 IF DATA=0
WRITE !?4,"No data to display"
+21 ;
+22 ; Write FF for print devices
+23 ; Else final Press Return...
+24 IF 'BPSCR
WRITE !,@IOF
+25 IF '$TEST
IF 'BPQ
DO PAUSE2
+26 ;
+27 ; Close the device and quit
+28 DO ^%ZISC
+29 QUIT
+30 ;
HDR ;
+1 ; Display Header.
+2 ; LCNT is returned
+3 NEW HDR,TAB
+4 SET HDR="Submissions Stranded from "_BPBDT_" through "_BPEDT
+5 SET TAB=80-$LENGTH(HDR)\2
+6 WRITE !!,?TAB,HDR
+7 WRITE !!?4,"TRANS DT",?15,"PATIENT NAME",?36,"ID",?41,"RX/FILL",?57,"DOS",?68,"INS CO"
+8 WRITE !,?4,"--------",?15,"------------",?36,"--",?41,"-------",?57,"---",?68,"------"
+9 SET LCNT=5
+10 QUIT
+11 ;
CHKP(BPSCR) ;
+1 ; Check for End of Page
+2 ; LCNT is returned
+3 NEW BPLINES
+4 IF $GET(BPSCR)
SET BPLINES=3
+5 IF '$TEST
SET BPLINES=1
+6 IF '$GET(IOSL)
QUIT 0
+7 IF IOSL'<(LCNT+BPLINES)
QUIT 0
+8 IF $GET(BPSCR)
SET BPQ=$$PAUSE
IF BPQ
QUIT 1
+9 DO HDR
+10 QUIT 0
+11 ;
PAUSE() ;
+1 NEW X
+2 USE IO(0)
+3 READ !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
+4 IF '$TEST!(X="^")
QUIT 1
+5 USE IO
+6 QUIT 0
+7 ;
PAUSE2 ;
+1 NEW X
+2 USE IO(0)
+3 READ !,"Press RETURN to continue: ",X:DTIME
+4 USE IO
+5 QUIT
+6 ;
UNSTRAND(IEN59,DATA) ;
+1 ; Unstrand a specific submission
+2 ;
+3 ; Input variables
+4 ; IEN59 - IEN of BPS TRANSACTION
+5 ; DATA - String of data delimited with caret ('^')
+6 ; Piece 1 - IEN of BPS REQUEST - If this is defined, it means that there
+7 ; was only a request record but no BPS TRANSACTION record
+8 ; Piece 2 - Patient Name
+9 ; Piece 3 - Date of Service
+10 ; Returns
+11 ; 1: Successful, 0:Unsucessful
+12 ;
+13 NEW MES,BPTYPE,HL7,MES,X
+14 ; If the IEN of BPS Request file is passed in, that means that there was no transaction
+15 ; data (no 0 node) so we need to just remove the request. This will be done by UNQUEUE.
+16 IF +$GET(DATA)>0
DO UNQUEUE(IEN59,+DATA)
QUIT 1
+17 ;
+18 ; Cancel the outgoing HL7 message. If it has a status of 1 (waiting in queue), cancel
+19 ; it. If the cancel fails, do not unstrand and display a message
+20 ; If it has a status of 1.5 (opening connection), do not unstrand and display a message
+21 ; Calls to HLUTIL supported by IA3098
+22 SET HL7=$PIECE($GET(^BPST(IEN59,0)),U,3)
SET MES=""
+23 IF HL7
Begin DoDot:1
+24 NEW STAT,RESLT,NAME,DATE
+25 SET STAT=+$$MSGSTAT^HLUTIL(HL7)
+26 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Checking on whether to remove the HL7 message "_HL7_" from the HL7 queue. Status is "_STAT)
+27 SET NAME=$$TRIM^XLFSTR($EXTRACT($PIECE(DATA,U,2),1,21))
SET DATE=$$DATTIM^BPSRPT1($PIECE(DATA,U,3))
+28 ; If status is 1 (Waiting in Queue), cancel the queue entry
+29 IF STAT=1
Begin DoDot:2
+30 SET RESLT=$$MSGACT^HLUTIL(HL7,1)
+31 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-HL7 message cancelled - Result is "_RESLT)
+32 ; If the cancel failed, set the message variable and do not unstrand
+33 IF RESLT=0
SET MES="The HL7 message for "_NAME_" on "_DATE_" could not be cancelled"
End DoDot:2
QUIT
+34 ; If status is 1.5 (Opening Connection), set the message variable but do not try to unstrand
+35 IF STAT=1.5
SET MES="The HL7 message for "_NAME_" on "_DATE_" is open on the HL7 queue"
End DoDot:1
IF MES]""
DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-"_MES)
WRITE !!,MES,!,"The transaction(s) should process normally/no further action required"
QUIT 0
+36 ;
+37 ; Set the result (error 99) and message
+38 SET BPTYPE=$PIECE($GET(^BPST(IEN59,0)),U,15)
+39 SET MES="E UNSTRANDED"
+40 IF BPTYPE="U"
SET MES="E REVERSAL UNSTRANDED"
+41 IF BPTYPE="E"
SET MES="E ELIGIBILITY UNSTRANDED"
+42 DO SETRESU^BPSOSU(IEN59,99,MES)
+43 ;
+44 ; Setting the status to 99% will call REQST99^BPSOSRX5, which will delete
+45 ; the current request and subsequent requests
+46 DO SETSTAT^BPSOSU(IEN59,99)
+47 ;
+48 ; Update the log
+49 SET MES=$TEXT(+0)_"-Unstranded"
+50 ; IA# 10060
IF $GET(DUZ)
SET MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E")
+51 DO LOG^BPSOSL(IEN59,MES)
+52 QUIT 1
+53 ;
+54 ;Remove all requests for this set of keys
UNQUEUE(IEN59,IEN77) ;
+1 NEW MES,KEY1,KEY2,BPTYPE,BPRETV
+2 IF 'IEN77
QUIT
+3 SET KEY1=$$GET1^DIQ(9002313.77,IEN77,.01,"I")
+4 SET KEY2=$$GET1^DIQ(9002313.77,IEN77,.02,"I")
+5 SET BPTYPE=$$GET1^DIQ(9002313.77,IEN77,1.04,"I")
+6 IF BPTYPE'="E"
Begin DoDot:1
+7 WRITE !,"Warning! The stranded request for the prescription #"_$$GET1^DIQ(9002313.77,IEN77,1.13,"E")_" and fill "_$$GET1^DIQ(9002313.77,IEN77,1.14,"E")
+8 WRITE !,"is being deleted. It might need to be submitted manually in the IB Claims"
+9 WRITE !,"Tracking Edit option."
+10 DO PRESSANY^BPSOSU5()
End DoDot:1
+11 ;
+12 ; Lock the request
+13 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Attempting to lock request with keys "_KEY1_", "_KEY2)
+14 SET BPRETV=$$LOCKRF^BPSOSRX(KEY1,KEY2,10,IEN59,$TEXT(+0))
+15 IF 'BPRETV
DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Cannot lock keys")
QUIT
+16 ;
+17 ; Set request to completed and delete any other subsequent or active requests
+18 ; Then unlock the record
+19 DO COMPLETD^BPSOSRX4(IEN77)
DO DELALLRQ^BPSOSRX7(IEN77,IEN59)
DO DELACTRQ^BPSOSRX6(KEY1,KEY2,IEN59)
+20 DO UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$TEXT(+0))
+21 ;
+22 ; Put message in log indicating that we have unstranded the request
+23 SET MES=$TEXT(+0)_"-Unqueued (unstranded)"
+24 ; IA# 10060
IF $GET(DUZ)
SET MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E")
+25 DO LOG^BPSOSL(IEN59,MES)
+26 QUIT
