| 1 | BPSUSCR1 ;BHAM ISC/FLS - STRANDED CLAIMS SCREEN ;10-MAR-2005
|
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | INIT ; -- init variables and list array
|
|---|
| 7 | N BPLN,BPLM,BP59,BPSORT,BPDUZ7,BPRET,CONT
|
|---|
| 8 | ;get date/time range
|
|---|
| 9 | K ^TMP($J),^TMP("BPSUSCR",$J)
|
|---|
| 10 | S BPTMPGL="^TMP(""BPSUSCR"",$J)"
|
|---|
| 11 | S CONT=1,VALMCNT=0
|
|---|
| 12 | D COLLECT^BPSUSCR4(.BPARR)
|
|---|
| 13 | Q
|
|---|
| 14 | ;
|
|---|
| 15 | HELP ; -- help code
|
|---|
| 16 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 17 | K X
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | EXIT ; -- exit code
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ; Warning message for 'Transmitting' claims
|
|---|
| 24 | MESSAGE() ;
|
|---|
| 25 | W !!!,"Please be aware that if there are claims appearing on the ECME User Screen"
|
|---|
| 26 | W !,"with a status of 'In progress - Transmitting', then there may be a problem"
|
|---|
| 27 | W !,"with HL7 or with system connectivity with the Austin Automation Center (AAC)."
|
|---|
| 28 | W !,"Please contact your IRM to verify that connectivity to the AAC is working"
|
|---|
| 29 | W !,"and the HL7 link BPS NCPDP is processing messages before using this option"
|
|---|
| 30 | W !,"to unstrand claims with a status of 'In progress - Transmitting'.",!
|
|---|
| 31 | N DIR,X,Y,BPQ
|
|---|
| 32 | S BPQ=0
|
|---|
| 33 | S DIR(0)="YA",DIR("A")="Do you want to continue? "
|
|---|
| 34 | S DIR("B")="NO"
|
|---|
| 35 | D ^DIR
|
|---|
| 36 | I Y'=1 S BPQ=1
|
|---|
| 37 | W !!
|
|---|
| 38 | Q BPQ
|
|---|
| 39 | ;
|
|---|
| 40 | GETDTS(BPARR) ; Transaction dates to view.
|
|---|
| 41 | N DIR
|
|---|
| 42 | K DIRUT,DIROUT,DUOUT,DTOUT,Y
|
|---|
| 43 | S DIR(0)="DA^:DT:EX",DIR("A")="FIRST TRANSACTION DATE: "
|
|---|
| 44 | S DIR("B")="T-1"
|
|---|
| 45 | D ^DIR
|
|---|
| 46 | Q:$D(DUOUT)!($D(DTOUT))
|
|---|
| 47 | S BPARR("BDT")=Y_".000001"
|
|---|
| 48 | ENDDT ;
|
|---|
| 49 | K DIRUT,DIROUT,DUOUT,DTOUT,Y
|
|---|
| 50 | S DIR(0)="DA^"_$P(BPARR("BDT"),".",1)_":DT:EX",DIR("A")="LAST TRANSACTION DATE: "
|
|---|
| 51 | S DIR("B")="T"
|
|---|
| 52 | D ^DIR
|
|---|
| 53 | Q:$D(DUOUT)!($D(DTOUT))
|
|---|
| 54 | S BPARR("EDT")=$$EDATE(Y)
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | EDATE(DATE) ;
|
|---|
| 58 | N RTN,%,%H
|
|---|
| 59 | S RTN=DATE_".235959"
|
|---|
| 60 | D NOW^%DTC
|
|---|
| 61 | I $P(%,".")=DATE S $P(%H,",",2)=$P(%H,",",2)-1800 D YX^%DTC S RTN=DATE_%
|
|---|
| 62 | Q RTN
|
|---|
| 63 | ALL ; Unstrand all claims currently selected.
|
|---|
| 64 | D FULL^VALM1
|
|---|
| 65 | N D0,DIR,SEQ,LAST
|
|---|
| 66 | S LAST=+$O(^TMP($J,2,""),-1)
|
|---|
| 67 | I LAST=0 D Q
|
|---|
| 68 | . W !,"There are no stranded claims in this date range to unstrand"
|
|---|
| 69 | . D PRESSANY^BPSOSU5()
|
|---|
| 70 | S DIR(0)="Y",DIR("A")="ARE YOU SURE? (YES/NO) ",DIR("B")="YES" D ^DIR Q:'Y
|
|---|
| 71 | W !,"PLEASE WAIT"
|
|---|
| 72 | S SEQ=0
|
|---|
| 73 | F S SEQ=$O(^TMP($J,2,SEQ)) Q:'SEQ D
|
|---|
| 74 | . S D0=""
|
|---|
| 75 | . F S D0=$O(^TMP($J,2,SEQ,D0)) Q:'D0 D
|
|---|
| 76 | . . D UNSTRAND(D0)
|
|---|
| 77 | . . Q
|
|---|
| 78 | . Q
|
|---|
| 79 | W !,"Done"
|
|---|
| 80 | D CLEAN^VALM10
|
|---|
| 81 | D COLLECT^BPSUSCR4(.BPARR)
|
|---|
| 82 | Q
|
|---|
| 83 | SELECT ; Select entries from the list and run each through the unstrand function
|
|---|
| 84 | N D0,DIR,I,J,VAR,BPTMPGL,PT,POP,LAST
|
|---|
| 85 | S LAST=+$O(^TMP($J,2,""),-1)
|
|---|
| 86 | I LAST=0 D Q
|
|---|
| 87 | . W !,"There are no stranded claims to select"
|
|---|
| 88 | . D PRESSANY^BPSOSU5()
|
|---|
| 89 | K DTOUT,DUOUT
|
|---|
| 90 | S BPTMPGL="^TMP(""BPSUSCR"",$J)"
|
|---|
| 91 | S VAR=""
|
|---|
| 92 | S DIR(0)="LO^1:"_LAST
|
|---|
| 93 | S DIR("A")="Enter a Selection of Stranded Claims",DIR("B")=""
|
|---|
| 94 | D ^DIR
|
|---|
| 95 | I $D(DTOUT)!$D(DUOUT) Q
|
|---|
| 96 | S VAR=Y
|
|---|
| 97 | F I=1:1:$L(VAR,",") S PT=$P(VAR,",",I) D
|
|---|
| 98 | . Q:PT=""
|
|---|
| 99 | . I PT'["-" S D0=$O(^TMP($J,2,PT,"")) D UNSTRAND(D0) Q
|
|---|
| 100 | . F J=$P(PT,"-"):1:$P(PT,"-",2) S D0=$O(^TMP($J,2,J,"")) D UNSTRAND(D0)
|
|---|
| 101 | . Q
|
|---|
| 102 | D CLEAN^VALM10
|
|---|
| 103 | D COLLECT^BPSUSCR4(.BPARR)
|
|---|
| 104 | Q
|
|---|
| 105 | PRINT ;
|
|---|
| 106 | N %ZIS
|
|---|
| 107 | S %ZIS="M"
|
|---|
| 108 | S %ZIS("A")="Select Printer: ",%ZIS("B")="" D ^%ZIS
|
|---|
| 109 | Q:IOPAR=""
|
|---|
| 110 | D PHDR
|
|---|
| 111 | D PLINE
|
|---|
| 112 | D ^%ZISC
|
|---|
| 113 | Q
|
|---|
| 114 | PHDR ;
|
|---|
| 115 | U IO
|
|---|
| 116 | W !,"Claims Stranded from ",BPBDT," through ",BPEDT
|
|---|
| 117 | ;
|
|---|
| 118 | W !!,?4,"TRANS DT",?15,"PATIENT NAME",?36,"ID",?41,"EXTERN RX#",?54,"RF",?57,"FILL DT",?68,"INS CO"
|
|---|
| 119 | W !,?4,"--------",?15,"------------",?36,"--",?41,"----------",?54,"--",?57,"-------",?68,"------"
|
|---|
| 120 | Q
|
|---|
| 121 | PLINE ;
|
|---|
| 122 | N SEQ,LINE
|
|---|
| 123 | S SEQ=0
|
|---|
| 124 | F S SEQ=$O(^TMP("BPSUSCR",$J,SEQ)) Q:'SEQ D
|
|---|
| 125 | . S LINE=$G(^TMP("BPSUSCR",$J,SEQ,0))
|
|---|
| 126 | . U IO
|
|---|
| 127 | . W !,$E(LINE,1,79)
|
|---|
| 128 | . Q
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
| 131 | ; Unstrand the claim
|
|---|
| 132 | ; Fileman read of New Person file (VA(200)) is covered by IA# 10600
|
|---|
| 133 | UNSTRAND(IEN59) ;
|
|---|
| 134 | N MES
|
|---|
| 135 | S MES="E STRANDED"
|
|---|
| 136 | I $P($G(^BPST(IEN59,4)),"^",1)!($P($G(^BPST(IEN59,4)),"^",4)]"") S MES="E REVERSAL STRANDED"
|
|---|
| 137 | D SETRESU^BPSOSU(IEN59,99,MES)
|
|---|
| 138 | D SETSTAT^BPSOSU(IEN59,99)
|
|---|
| 139 | S MES=$T(+0)_"-Unstranded"
|
|---|
| 140 | I $G(DUZ) S MES=MES_" by "_$$GET1^DIQ(200,DUZ,.01,"E")
|
|---|
| 141 | D LOG^BPSOSL(IEN59,MES)
|
|---|
| 142 | Q
|
|---|
