source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSUSCR1.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1BPSUSCR1 ;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 ;
6INIT ; -- 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 ;
15HELP ; -- help code
16 S X="?" D DISP^XQORM1 W !!
17 K X
18 Q
19 ;
20EXIT ; -- exit code
21 Q
22 ;
23 ; Warning message for 'Transmitting' claims
24MESSAGE() ;
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 ;
40GETDTS(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"
48ENDDT ;
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 ;
57EDATE(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
63ALL ; 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
83SELECT ; 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
105PRINT ;
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
114PHDR ;
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
121PLINE ;
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
133UNSTRAND(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
Note: See TracBrowser for help on using the repository browser.