Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSUSCR1

BPSUSCR1.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Reference to file 200 in ICR# 10060
  1. ; Reference to $$MSGSTAT^HLUTIL and $$MSGACT^HLUTIL in ICR# 3098
  1. ; Reference to $$TRIM^XLFSTR in ICR# 10104
  1. ;
  1. Q
  1. ;
  1. ; Warning message for 'Transmitting' submissions
  1. MESSAGE() ;
  1. W !!!,"Please be aware that if there are submissions appearing on the ECME User Screen"
  1. W !,"with a status of 'In progress - Transmitting', then there may be a problem"
  1. W !,"with HL7 or with system connectivity with the Austin Automation Center (AAC)."
  1. W !,"Please contact your IRM to verify that connectivity to the AAC is working"
  1. W !,"and the HL7 link BPS NCPDP is processing messages before using this option"
  1. W !,"to unstrand submissions with a status of 'In progress - Transmitting'.",!
  1. N DIR,X,Y,BPQ
  1. S BPQ=0
  1. S DIR(0)="YA",DIR("A")="Do you want to continue? "
  1. S DIR("B")="NO"
  1. D ^DIR
  1. I Y'=1 S BPQ=1
  1. W !!
  1. Q BPQ
  1. ;
  1. GETDTS(BPARR) ; Transaction dates to view.
  1. N DIR
  1. K DIRUT,DIROUT,DUOUT,DTOUT,Y
  1. S DIR(0)="DA^:DT:EX",DIR("A")="FIRST TRANSACTION DATE: "
  1. S DIR("B")="T-1"
  1. D ^DIR
  1. Q:$D(DUOUT)!($D(DTOUT))
  1. S BPARR("BDT")=Y_".000001"
  1. ENDDT ;
  1. K DIRUT,DIROUT,DUOUT,DTOUT,Y
  1. S DIR(0)="DA^"_$P(BPARR("BDT"),".",1)_":DT:EX",DIR("A")="LAST TRANSACTION DATE: "
  1. S DIR("B")="T"
  1. D ^DIR
  1. Q:$D(DUOUT)!($D(DTOUT))
  1. S BPARR("EDT")=$$EDATE(Y)
  1. Q
  1. ;
  1. EDATE(DATE) ;
  1. N RTN,%,%H
  1. S RTN=DATE_".235959"
  1. D NOW^%DTC
  1. I $P(%,".")=DATE S $P(%H,",",2)=$P(%H,",",2)-1800 D YX^%DTC S RTN=DATE_%
  1. Q RTN
  1. ;
  1. ALL ; Unstrand all submissions currently selected.
  1. D FULL^VALM1
  1. N BPSD0,SEQ,LAST,TMP,TMP2,RET
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S LAST=+$O(^TMP("BPSUSCR-2",$J,""),-1)
  1. I LAST=0 D Q
  1. . W !,"There are no stranded submissions in this date range to unstrand"
  1. . K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
  1. ; Display message if there are multiple types on the queue
  1. S TMP=$O(^TMP("BPSUSCR-1",$J,""))
  1. I TMP S TMP2=$O(^TMP("BPSUSCR-1",$J,TMP))
  1. I TMP2 D
  1. . W !,"Please be aware there are multiple types of requests currently stranded."
  1. . W !,"Are you sure you want to unstrand ALL submissions? If not, exit this"
  1. . W !,"action and select which submissions you want to unstrand."
  1. . W !!,"Answer NO to following prompt if you wish to SELECT the submissions to unstrand.",!
  1. S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO" D ^DIR Q:'Y
  1. W !,"Please wait..."
  1. S SEQ=0,RET=0
  1. F S SEQ=$O(^TMP("BPSUSCR-2",$J,SEQ)) Q:'SEQ D
  1. . S BPSD0=""
  1. . F S BPSD0=$O(^TMP("BPSUSCR-2",$J,SEQ,BPSD0)) Q:'BPSD0 D
  1. . . S X=$$UNSTRAND(BPSD0,$G(^TMP("BPSUSCR-2",$J,SEQ,BPSD0)))
  1. . . I 'X S RET=1
  1. . . Q
  1. . Q
  1. I 'RET W !,"Done"
  1. E K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
  1. D CLEAN^VALM10
  1. D COLLECT^BPSUSCR4(.BPARR)
  1. Q
  1. ;
  1. SELECT ; Select entries from the list and run each through the unstrand function
  1. D FULL^VALM1
  1. N D0,I,J,VAR,BPTMPGL,PT,POP,LAST,RET
  1. N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S LAST=+$O(^TMP("BPSUSCR-2",$J,""),-1)
  1. I LAST=0 D Q
  1. . W !,"There are no stranded submissions to select"
  1. . K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
  1. K DTOUT,DUOUT
  1. S BPTMPGL="^TMP(""BPSUSCR"",$J)"
  1. S VAR=""
  1. K DIR
  1. S DIR(0)="LO^1:"_LAST
  1. S DIR("A")="Enter a Selection of Stranded Submissions",DIR("B")=""
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. S VAR=Y,RET=0
  1. F I=1:1:$L(VAR,",") S PT=$P(VAR,",",I) D
  1. . Q:PT=""
  1. . 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
  1. . 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
  1. . Q
  1. I RET K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue" D ^DIR
  1. D CLEAN^VALM10
  1. D COLLECT^BPSUSCR4(.BPARR)
  1. Q
  1. ;
  1. PRINT ;
  1. ; Full Screen Mode
  1. D FULL^VALM1
  1. ; Prompt for pinter
  1. N %ZIS,POP
  1. S %ZIS="M",%ZIS("A")="Select Printer: ",%ZIS("B")="" D ^%ZIS
  1. I POP Q
  1. ; Use device
  1. U IO
  1. ; Create Report
  1. D REPORT
  1. Q
  1. ;
  1. REPORT ;
  1. N SEQ,LINE,BPQ,LCNT,DATA,BPSCR
  1. ;
  1. ; Set flag for interactive device
  1. S BPSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1. ;
  1. ; Print first header
  1. D HDR
  1. ;
  1. ; Loop through data and display
  1. S SEQ=0,BPQ=0,DATA=0
  1. F S SEQ=$O(^TMP("BPSUSCR",$J,SEQ)) Q:'SEQ D I BPQ Q
  1. . S LINE=$G(^TMP("BPSUSCR",$J,SEQ,0))
  1. . ; Check if we filled a page
  1. . S BPQ=$$CHKP(BPSCR) I BPQ Q
  1. . W !,$E(LINE,1,79)
  1. . S LCNT=LCNT+1
  1. . S DATA=1
  1. ;
  1. ; If no data, display message
  1. I DATA=0 W !?4,"No data to display"
  1. ;
  1. ; Write FF for print devices
  1. ; Else final Press Return...
  1. I 'BPSCR W !,@IOF
  1. E I 'BPQ D PAUSE2
  1. ;
  1. ; Close the device and quit
  1. D ^%ZISC
  1. Q
  1. ;
  1. HDR ;
  1. ; Display Header.
  1. ; LCNT is returned
  1. N HDR,TAB
  1. S HDR="Submissions Stranded from "_BPBDT_" through "_BPEDT
  1. S TAB=80-$L(HDR)\2
  1. W !!,?TAB,HDR
  1. W !!?4,"TRANS DT",?15,"PATIENT NAME",?36,"ID",?41,"RX/FILL",?57,"DOS",?68,"INS CO"
  1. W !,?4,"--------",?15,"------------",?36,"--",?41,"-------",?57,"---",?68,"------"
  1. S LCNT=5
  1. Q
  1. ;
  1. CHKP(BPSCR) ;
  1. ; Check for End of Page
  1. ; LCNT is returned
  1. N BPLINES
  1. I $G(BPSCR) S BPLINES=3
  1. E S BPLINES=1
  1. I '$G(IOSL) Q 0
  1. I IOSL'<(LCNT+BPLINES) Q 0
  1. I $G(BPSCR) S BPQ=$$PAUSE I BPQ Q 1
  1. D HDR
  1. Q 0
  1. ;
  1. PAUSE() ;
  1. N X
  1. U IO(0)
  1. R !!,"Press RETURN to continue, '^' to exit: ",X:DTIME
  1. I '$T!(X="^") Q 1
  1. U IO
  1. Q 0
  1. ;
  1. PAUSE2 ;
  1. N X
  1. U IO(0)
  1. R !,"Press RETURN to continue: ",X:DTIME
  1. U IO
  1. Q
  1. ;
  1. UNSTRAND(IEN59,DATA) ;
  1. ; Unstrand a specific submission
  1. ;
  1. ; Input variables
  1. ; IEN59 - IEN of BPS TRANSACTION
  1. ; DATA - String of data delimited with caret ('^')
  1. ; Piece 1 - IEN of BPS REQUEST - If this is defined, it means that there
  1. ; was only a request record but no BPS TRANSACTION record
  1. ; Piece 2 - Patient Name
  1. ; Piece 3 - Date of Service
  1. ; Returns
  1. ; 1: Successful, 0:Unsucessful
  1. ;
  1. N BPTYPE,FILL,HL7,MES,RX,X
  1. ;
  1. ; If the IEN of BPS Request file is passed in, that means that there was no transaction
  1. ; data (no 0 node) so we need to just remove the request. This will be done by UNQUEUE.
  1. I +$G(DATA)>0 D Q 1
  1. . D UNQUEUE(IEN59,+DATA)
  1. . ;
  1. . ; Add an entry to the ECME log.
  1. . ;
  1. . S RX=$$GET1^DIQ(9002313.77,+DATA,.01,"I")
  1. . S FILL=+$$GET1^DIQ(9002313.77,+DATA,.02,"I")
  1. . D RXACT^PSOBPSU2(RX,FILL,"CLAIM UNSTRANDED","M",DUZ)
  1. . Q
  1. ;
  1. ; Cancel the outgoing HL7 message. If it has a status of 1 (waiting in queue), cancel
  1. ; it. If the cancel fails, do not unstrand and display a message
  1. ; If it has a status of 1.5 (opening connection), do not unstrand and display a message
  1. S HL7=$P($G(^BPST(IEN59,0)),U,3),MES=""
  1. 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
  1. . N STAT,RESLT,NAME,DATE
  1. . S STAT=+$$MSGSTAT^HLUTIL(HL7)
  1. . D LOG^BPSOSL(IEN59,$T(+0)_"-Checking on whether to remove the HL7 message "_HL7_" from the HL7 queue. Status is "_STAT)
  1. . S NAME=$$TRIM^XLFSTR($E($P(DATA,U,2),1,21)),DATE=$$DATTIM^BPSRPT1($P(DATA,U,3))
  1. . ; If status is 1 (Waiting in Queue), cancel the queue entry
  1. . I STAT=1 D Q
  1. . . S RESLT=$$MSGACT^HLUTIL(HL7,1)
  1. . . D LOG^BPSOSL(IEN59,$T(+0)_"-HL7 message cancelled - Result is "_RESLT)
  1. . . ; If the cancel failed, set the message variable and do not unstrand
  1. . . I RESLT=0 S MES="The HL7 message for "_NAME_" on "_DATE_" could not be cancelled"
  1. . ; If status is 1.5 (Opening Connection), set the message variable but do not try to unstrand
  1. . I STAT=1.5 S MES="The HL7 message for "_NAME_" on "_DATE_" is open on the HL7 queue"
  1. ;
  1. ; Set the result (error 99) and message
  1. S BPTYPE=$P($G(^BPST(IEN59,0)),U,15)
  1. S MES="E UNSTRANDED"
  1. I BPTYPE="U" S MES="E REVERSAL UNSTRANDED"
  1. I BPTYPE="E" S MES="E ELIGIBILITY UNSTRANDED"
  1. D SETRESU^BPSOSU(IEN59,99,MES)
  1. ;
  1. ; Setting the status to 99% will call REQST99^BPSOSRX5, which will delete
  1. ; the current request and subsequent requests
  1. D SETSTAT^BPSOSU(IEN59,99)
  1. ;
  1. ; Update the log
  1. S MES=$T(+0)_"-Unstranded"
  1. I $G(DUZ) S MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E") ; IA# 10060
  1. D LOG^BPSOSL(IEN59,MES)
  1. ;
  1. ; Add an entry to the ECME log.
  1. ;
  1. S RX=$$GET1^DIQ(9002313.59,IEN59,1.11,"I")
  1. S FILL=+$$GET1^DIQ(9002313.59,IEN59,9,"I")
  1. D RXACT^PSOBPSU2(RX,FILL,"CLAIM UNSTRANDED","M",DUZ)
  1. ;
  1. Q 1
  1. ;
  1. ;Remove all requests for this set of keys
  1. UNQUEUE(IEN59,IEN77) ;
  1. N MES,KEY1,KEY2,BPTYPE,BPRETV
  1. I 'IEN77 Q
  1. S KEY1=$$GET1^DIQ(9002313.77,IEN77,.01,"I")
  1. S KEY2=$$GET1^DIQ(9002313.77,IEN77,.02,"I")
  1. S BPTYPE=$$GET1^DIQ(9002313.77,IEN77,1.04,"I")
  1. I BPTYPE'="E" D
  1. . 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")
  1. . W !,"is being deleted. It might need to be submitted manually in the IB Claims"
  1. . W !,"Tracking Edit option."
  1. . D PRESSANY^BPSOSU5()
  1. ;
  1. ; Lock the request
  1. D LOG^BPSOSL(IEN59,$T(+0)_"-Attempting to lock request with keys "_KEY1_", "_KEY2)
  1. S BPRETV=$$LOCKRF^BPSOSRX(KEY1,KEY2,10,IEN59,$T(+0))
  1. I 'BPRETV D LOG^BPSOSL(IEN59,$T(+0)_"-Cannot lock keys") Q
  1. ;
  1. ; Set request to completed and delete any other subsequent or active requests
  1. ; Then unlock the record
  1. D COMPLETD^BPSOSRX4(IEN77),DELALLRQ^BPSOSRX7(IEN77,IEN59),DELACTRQ^BPSOSRX6(KEY1,KEY2,IEN59)
  1. D UNLCKRF^BPSOSRX(KEY1,KEY2,IEN59,$T(+0))
  1. ;
  1. ; Put message in log indicating that we have unstranded the request
  1. S MES=$T(+0)_"-Unqueued (unstranded)"
  1. I $G(DUZ) S MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E") ; IA# 10060
  1. D LOG^BPSOSL(IEN59,MES)
  1. Q