source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRBEPEND.m@ 632

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1LRBEPEND ;DALOI/JAH/FHS - PENDING PANEL REPORT ;11/26/2005
2 ;;5.2;LAB SERVICE;**291,337**;Sep 27, 1994;Build 2
3 ;
4EN ;Entry point from menu option LRBE PENDREP
5 N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
6 S ZTRTN="TASK^LRBEPEND"
7 S ZTDESC="Lab Report on Pending AMA/Billable Panels"
8 S ZTIO=""
9 S ZTSAVE("DUZ")=""
10 W !!,"This report option must be queued via TaskManager."
11 W !,"The report will be sent to you as a MailMan message.",!
12 D ^%ZTLOAD
13 I $G(ZTSK) D
14 .W !,"Report queued as Task #: ",ZTSK
15 W !
16 Q
17 ;
18TASK ;Entry point from Taskmgr
19 N LRBERLDT,DATX,YY,MM,STARTDT,ENDDT,TOTPAN
20 K ^TMP("LRPENDING",$J)
21 S ^TMP("LRPENDING",$J,0)=$$NOW^XLFDT_"^"
22 S LRBERLDT=$P(^LAB(69.9,1,"VSIT"),U,2)
23 I 'LRBERLDT S (STARTDT,ENDDT)=""
24 I LRBERLDT D
25 .S YY=$E(LRBERLDT,1,3),MM=+$E(LRBERLDT,4,5)
26 .S MM=$S(MM=1:12,1:MM-1) S YY=$S(MM=12:YY-1,1:YY) I $L(MM)=1 S MM="0"_MM
27 .S STARTDT=YY_MM_"01",ENDDT=YY_MM_"31"_".999999"
28 .S DATX=$O(^LRO(69,"APP",0))
29 .I DATX,DATX<STARTDT S STARTDT=DATX
30 .D START
31 S ^TMP("LRPENDING",$J,0)=^TMP("LRPENDING",$J,0)_$$NOW^XLFDT()
32 D MAILRPT
33 Q
34 ;
35START ;Loop thru pending panel xref in file #69
36 N LINE,LRXDT,LRODT,LRSN,LRTN
37 S LINE=100,TOTPAN=0
38 S LRXDT=STARTDT-1 F S LRXDT=$O(^LRO(69,"APP",LRXDT)) Q:'LRXDT Q:LRXDT>ENDDT D
39 .S LRODT=0 F S LRODT=$O(^LRO(69,"APP",LRXDT,LRODT)) Q:'LRODT D
40 ..S LRSN=0 F S LRSN=$O(^LRO(69,"APP",LRXDT,LRODT,LRSN)) Q:'LRSN D
41 ...S LRTN=0 F S LRTN=$O(^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN)) Q:'LRTN D
42 ....D SET
43 ....I $D(LRBEY)>1 D SETRPT
44 ....D CLEAN
45 Q
46 ;
47SET ;Setup background variables for call to BAWRK^LRBEBA
48 N I,LRBET,LRBEIEN,NX,XX
49 S LRBEIEN=LRSN_","_LRODT_","
50 S LRDFN=$$GET1^DIQ(69.01,LRBEIEN,.01,"I")
51 S LRORDER=$$GET1^DIQ(69.01,LRBEIEN,9.5,"I")
52 S LRBEIEN=LRTN_","_LRSN_","_LRODT_","
53 S LRBETST=$$GET1^DIQ(69.03,LRBEIEN,.01,"I")
54 I LRBETST="" K ^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN) Q
55 S LRAD=+$$GET1^DIQ(69.03,LRBEIEN,2,"I")
56 S LRAA=+$$GET1^DIQ(69.03,LRBEIEN,3,"I")
57 S LRAN=+$$GET1^DIQ(69.03,LRBEIEN,4,"I")
58 S LRUID=$$GET1^DIQ(69.03,LRBEIEN,13,"I")
59 S LRBECDT=$$GET1^DIQ(69.03,LRBEIEN,22,"I")
60 S LRBEDFN=$$GET1^DIQ(63,LRDFN,.03,"I")
61 S LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
62 I $G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBETST,0))="" K ^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN) Q
63 S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
64 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
65 I I S X=^LRO(68,LRAA,1,LRAD,1,LRAN,5,I,0),LRSPEC=$P(X,U,1),LRSAMP=$P(X,U,2)
66 S NX=0 F S NX=$O(^LAB(60,LRBETST,2,NX)) Q:'NX D
67 .S LRBET=+^LAB(60,LRBETST,2,NX,0)
68 .Q:('$P(^LAB(60,LRBET,0),U,17))
69 .S XX=$P($P(^LAB(60,LRBET,0),U,5),";",2)
70 .;if null XX, possibly another panel
71 .I 'XX D ARRS^LRBEBA5(LRBET,LRBETST) Q
72 .S LRSB(XX)=$G(^LR(LRDFN,LRSS,LRIDT,XX))
73 .I LRSB(XX)="" K LRSB(XX) Q
74 .I $P(LRSB(XX),U,1)["canc" K LRSB(XX) Q
75 .I $P(LRSB(XX),U,13) K LRSB(XX) Q
76 .S LRBEY(LRBETST,XX)=""
77 I $D(LRBEY)>1 D
78 .S LRTEST(1)=LRBETST_U_^LAB(60,LRBETST,0),LRTEST(1,"P")=LRBETST_U_$$NLT^LRVER1(LRBETST)
79 Q
80 ;
81CLEAN ;Clean-up variables
82 K LRBEY,LRTEST,LRSB,LRBECPT,LRDFN,LRBEDFN,LRORDER
83 K LRBETST,LRBEVST,LRAA,LRAN,LRAD,LRUID,LRBECDT,LRSS,LRIDT,LRSAMP,LRSPEC
84 Q
85 ;
86SETRPT ;Set veriables into ^TMP( for report
87 N SETLN,X,C,CX,PATNM,XCODE,LRBETST,LRBETSTN
88 S TOTPAN=TOTPAN+1
89 S SETLN="S LINE=LINE+1,^TMP(""LRPENDING"",$J,LINE,0)=X"
90 S X=$P(^DPT(LRBEDFN,0),U,1,9),PATNM=$E($P(X,U,1),1,20)_" ("_$E($P(X,U,9),6,9)_")"
91 S LRBETST=$P(LRTEST(1),U,1)
92 S LRBETSTN=$P(^LAB(60,LRBETST,0),U,1),LRBETSTN="["_LRBETST_"] "_$E(LRBETSTN,1,26)
93 S:$G(LRBECDT)="" LRBECDT=DT D PANEL^LRBEBA4
94 S X=$$SETSTR^VALM1(LRUID,"",1,10)
95 S X=$$SETSTR^VALM1(PATNM,X,14,28),X=$$SETSTR^VALM1(LRBETSTN,X,44,34) X SETLN
96 S C=$O(LRBECPT(LRBETST,1,0))
97 I C D
98 . S XCODE=$P($$CPT^ICPTCOD(C),U,2,3),XCODE=$TR(XCODE,"^"," "),XCODE=$E(XCODE,1,30)
99 . S X=$$SETSTR^VALM1("Panel CPT Code:","",14,16),X=$$SETSTR^VALM1(XCODE,X,32,40) X SETLN
100 . S CX=LRBECPT(LRBETST,1,C),X=$$SETSTR^VALM1(CX,"",32,40) X SETLN
101 I 'C D
102 . S X=$$SETSTR^VALM1("Panel CPT Code:","",14,16),X=$$SETSTR^VALM1("<No active CPT available>",X,32,40) X SETLN
103 S X=" " X SETLN
104 Q
105 ;
106MAILRPT ;Set intro & send pending panel report to user
107 N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,X,X1,Y,SETLN,LINE,DASH,REPDT
108 S STARTDT=$P(STARTDT,".",1)
109 I ENDDT S ENDDT=$P(ENDDT,".",1),X=ENDDT D
110 .S X1=X,X=+$E(X,4,5),X=$S("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$E(X1,1,3)#4:28,1:29)
111 .I $E(X1,6,7)>X S $E(ENDDT,6,7)=X
112 S LINE=0,SETLN="S LINE=LINE+1,^TMP(""LRPENDING"",$J,LINE,0)=X"
113 S $P(DASH,"-",78)=""
114 S X=" " X SETLN
115 S X="This report provides a listing of AMA/Billable panel tests that are pending" X SETLN
116 S X="completion as of the Report Date/Time. The Sample Collection Date for the" X SETLN
117 S X="panel test falls within the date range indicated by Start Date and End Date." X SETLN
118 S X="One or more of the 'required' atomic tests comprising the panel do not yet" X SETLN
119 S X="have a verified result." X SETLN
120 S X=" " X SETLN
121 S X="Normally, panel tests flagged as 'AMA/Billable' should be reported to PCE" X SETLN
122 S X="using the CPT Code of the panel. In order for the panel CPT Code to be" X SETLN
123 S X="sent to PCE, a verified result must be present for each 'required' atomic" X SETLN
124 S X="test comprising the panel. If all required atomic tests have not been" X SETLN
125 S X="verified by the Next Lab Roll-up Date, then the CPT Codes for the individual" X SETLN
126 S X="atomic tests will be sent to PCE." X SETLN
127 S X=" " X SETLN
128 S X="Note: This report may not show any panels if it is run after the roll-up to" X SETLN
129 S X="PCE but before the end of the month. Please consult the Roll-up to PCE Report" X SETLN
130 S X="sent to G.LIM for information on unbundled panels not reported here." X SETLN
131 S X=" " X SETLN
132 S X=" " X SETLN
133 S Y=$$NOW^XLFDT() D DD^%DT S REPDT=Y
134 S X="Report Date/Time : "_REPDT X SETLN
135 I LRBERLDT S Y=LRBERLDT D DD^%DT S LRBERLDT=Y
136 S X="Next Lab Roll-up Date : "_LRBERLDT X SETLN
137 I STARTDT S Y=STARTDT D DD^%DT S STARTDT=Y
138 S X="Start Date : "_STARTDT X SETLN
139 I ENDDT S Y=ENDDT D DD^%DT S ENDDT=Y
140 S X="End Date : "_ENDDT X SETLN
141 S X="Total # Panels : "_$G(TOTPAN) X SETLN
142 S X=" " X SETLN
143 S X=" " X SETLN
144 S X=$$SETSTR^VALM1("Unique","",1,10) X SETLN
145 S X=$$SETSTR^VALM1("Identifier",X,1,10),X=$$SETSTR^VALM1("Patient",X,14,28)
146 S X=$$SETSTR^VALM1("Panel Test",X,44,34) X SETLN
147 S X=$$SETSTR^VALM1(DASH,"",1,78) X SETLN
148 S XMSUB="AMA/Billable Panel Pending List "_REPDT
149 S XMDUZ=.5
150 S XMY(DUZ)=""
151 S XMTEXT="^TMP(""LRPENDING"",$J,"
152 D ^XMD
153 K ^TMP("LRPENDING",$J)
154 Q
Note: See TracBrowser for help on using the repository browser.