- BPSUSCR1 ;BHAM ISC/FLS - STRANDED SUBMISSIONS SCREEN (cont) ;10-MAR-2005
- ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10,11,27,38**;JUN 2004;Build 7
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ; Reference to file 200 in ICR# 10060
- ; Reference to $$MSGSTAT^HLUTIL and $$MSGACT^HLUTIL in ICR# 3098
- ; Reference to $$TRIM^XLFSTR in ICR# 10104
- ;
- 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 BPTYPE,FILL,HL7,MES,RX,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 Q 1
- . D UNQUEUE(IEN59,+DATA)
- . ;
- . ; Add an entry to the ECME log.
- . ;
- . S RX=$$GET1^DIQ(9002313.77,+DATA,.01,"I")
- . S FILL=+$$GET1^DIQ(9002313.77,+DATA,.02,"I")
- . D RXACT^PSOBPSU2(RX,FILL,"CLAIM UNSTRANDED","M",DUZ)
- . Q
- ;
- ; 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
- 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)
- ;
- ; Add an entry to the ECME log.
- ;
- S RX=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
- S FILL=+$$GET1^DIQ(9002313.59,IEN59,9,"I")
- D RXACT^PSOBPSU2(RX,FILL,"CLAIM UNSTRANDED","M",DUZ)
- ;
- 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 9781 printed Feb 18, 2025@23:19:55 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,38**;JUN 2004;Build 7
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; Reference to file 200 in ICR# 10060
- +5 ; Reference to $$MSGSTAT^HLUTIL and $$MSGACT^HLUTIL in ICR# 3098
- +6 ; Reference to $$TRIM^XLFSTR in ICR# 10104
- +7 ;
- +8 QUIT
- +9 ;
- +10 ; 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 BPTYPE,FILL,HL7,MES,RX,X
- +14 ;
- +15 ; If the IEN of BPS Request file is passed in, that means that there was no transaction
- +16 ; data (no 0 node) so we need to just remove the request. This will be done by UNQUEUE.
- +17 IF +$GET(DATA)>0
- Begin DoDot:1
- +18 DO UNQUEUE(IEN59,+DATA)
- +19 ;
- +20 ; Add an entry to the ECME log.
- +21 ;
- +22 SET RX=$$GET1^DIQ(9002313.77,+DATA,.01,"I")
- +23 SET FILL=+$$GET1^DIQ(9002313.77,+DATA,.02,"I")
- +24 DO RXACT^PSOBPSU2(RX,FILL,"CLAIM UNSTRANDED","M",DUZ)
- +25 QUIT
- End DoDot:1
- QUIT 1
- +26 ;
- +27 ; Cancel the outgoing HL7 message. If it has a status of 1 (waiting in queue), cancel
- +28 ; it. If the cancel fails, do not unstrand and display a message
- +29 ; If it has a status of 1.5 (opening connection), do not unstrand and display a message
- +30 SET HL7=$PIECE($GET(^BPST(IEN59,0)),U,3)
- SET MES=""
- +31 IF HL7
- Begin DoDot:1
- +32 NEW STAT,RESLT,NAME,DATE
- +33 SET STAT=+$$MSGSTAT^HLUTIL(HL7)
- +34 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Checking on whether to remove the HL7 message "_HL7_" from the HL7 queue. Status is "_STAT)
- +35 SET NAME=$$TRIM^XLFSTR($EXTRACT($PIECE(DATA,U,2),1,21))
- SET DATE=$$DATTIM^BPSRPT1($PIECE(DATA,U,3))
- +36 ; If status is 1 (Waiting in Queue), cancel the queue entry
- +37 IF STAT=1
- Begin DoDot:2
- +38 SET RESLT=$$MSGACT^HLUTIL(HL7,1)
- +39 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-HL7 message cancelled - Result is "_RESLT)
- +40 ; If the cancel failed, set the message variable and do not unstrand
- +41 IF RESLT=0
- SET MES="The HL7 message for "_NAME_" on "_DATE_" could not be cancelled"
- End DoDot:2
- QUIT
- +42 ; If status is 1.5 (Opening Connection), set the message variable but do not try to unstrand
- +43 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
- +44 ;
- +45 ; Set the result (error 99) and message
- +46 SET BPTYPE=$PIECE($GET(^BPST(IEN59,0)),U,15)
- +47 SET MES="E UNSTRANDED"
- +48 IF BPTYPE="U"
- SET MES="E REVERSAL UNSTRANDED"
- +49 IF BPTYPE="E"
- SET MES="E ELIGIBILITY UNSTRANDED"
- +50 DO SETRESU^BPSOSU(IEN59,99,MES)
- +51 ;
- +52 ; Setting the status to 99% will call REQST99^BPSOSRX5, which will delete
- +53 ; the current request and subsequent requests
- +54 DO SETSTAT^BPSOSU(IEN59,99)
- +55 ;
- +56 ; Update the log
- +57 SET MES=$TEXT(+0)_"-Unstranded"
- +58 ; IA# 10060
- IF $GET(DUZ)
- SET MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E")
- +59 DO LOG^BPSOSL(IEN59,MES)
- +60 ;
- +61 ; Add an entry to the ECME log.
- +62 ;
- +63 SET RX=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
- +64 SET FILL=+$$GET1^DIQ(9002313.59,IEN59,9,"I")
- +65 DO RXACT^PSOBPSU2(RX,FILL,"CLAIM UNSTRANDED","M",DUZ)
- +66 ;
- +67 QUIT 1
- +68 ;
- +69 ;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