source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPROCT.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1ECXPROCT ;ALB/GTS - ProstheticS Cost by PSAS HCPC Report DSS ; 12/15/06 3:55pm
2 ;;3.0;DSS EXTRACTS;**71,100**;Dec 22, 1997;Build 2
3 ;
4EN ;entry point from option
5 ;Initialize varables
6 N DIR,ECSD1,ECED,X,Y
7 ;Prompt for start date
8 S DIR(0)="D^::EX"
9 S DIR("A")="Enter Report Start Date"
10 D ^DIR
11 I $D(DIRUT) Q
12 S ECSD1=Y
13 ;Prompt for end date
14 K DIR,X,Y
15 S DIR(0)="D^"_ECSD1_":"_DT_":EX"
16 S DIR("A")="Enter Report Ending Date"
17 D ^DIR
18 I $D(DIRUT) Q
19 S ECED=Y
20 ;Queue Report
21 W !!,"** REPORT REQUIRES 132 COLUMNS TO PRINT CORRECTLY **",!!
22 N ZTDESC,ZTIO,ZTSAVE
23 S ZTIO=""
24 S ZTDESC="Prosthetic Cost by PSAS HCPC Report for DSS"
25 F I="ECSD1","ECED","ECXPHCPC","ECXPHDESC","ECXHCPC","ECXQTY","ECXUOFI","ECXCOST","ECXTCOST" D
26 .S ZTSAVE(I)=""
27 D EN^XUTMDEVQ("EN1^ECXPROCT",ZTDESC,.ZTSAVE)
28 Q
29 ;
30EN1 ;Tasked entry point
31 ;Input : ECSD1 - FM format report start date
32 ; ECED - FM format report end date
33 ;
34 ;Output : None
35 ;
36 ;Declare variables
37 N ECXPHCPC,ECXHCDES,ECXHCPC,ECXQTY,ECXUOFI,ECXCOST,ECXTCOST,PAGENUM
38 N ECXLNE,ECXCT,ECXDACT,ECX0,ECX1,ECXED1,ECINSTSV,ECXLNSTR,ECXP
39 N DIC,DR,DA,DIQ
40 S ECXED1=ECED+.9999,ECXCT=ECSD1,(CNT,QFLG,PAGENUM,ECXTCOST,ECXQTY,STOP)=0
41 D HEADER I STOP D EXIT Q
42 D GETDATA
43 I '$D(^TMP("ECXDSS",$J)) D Q
44 .W !
45 .W !,"***********************************************"
46 .W !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
47 .W !,"***********************************************"
48 .D WAIT
49 D DETAIL I STOP D EXIT Q
50 D TOTAL
51 K ^TMP("ECXDSS",$J)
52 Q
53 ;
54GETDATA ;Get data
55 F S ECXCT=$O(^RMPR(660,"CT",ECXCT)),CNT=CNT+1 Q:(ECXCT>ECXED1)!('ECXCT)!(QFLG=1) D
56 .S ECXDACT=0
57 .F S ECXDACT=$O(^RMPR(660,"CT",ECXCT,ECXDACT)) Q:('ECXDACT)!(QFLG=1) D
58 ..;Get data nodes and icrement conunter
59 ..S CNT=CNT+1
60 ..S ECX0=$G(^RMPR(660,ECXDACT,0)),ECX1=$G(^(1))
61 ..Q:'$D(^RMPR(660,ECXDACT,0))
62 ..S ECXPHCPC=$P(ECX1,U,4),ECHCDES=$P(ECX1,U,2),ECXHCPC=$P(ECX0,U,22)
63 ..S ECXQTY=$P(ECX0,U,7),ECXUOFI=$P(ECX0,U,8),ECXCOST=$P(ECX0,U,16)
64 ..;Resolve external values for PSAS HCPC
65 ..K DIC S DIC="^RMPR(661.1,",DIC(0)="NZ",X=ECXPHCPC D ^DIC
66 ..;S ECXPHCPC=$P($G(Y(0)),U,1)
67 ..S ECXPHCPC=$E($P($G(Y(0)),U,1),1,5)
68 ..;Resolve external values for HCPC
69 ..K DIC S DIC="^ICPT(",DIC(0)="NZ",X=ECXHCPC D ^DIC
70 ..S ECXHCPC=$P($G(Y(0)),U,1)
71 ..;Resolve external value for unit of issue
72 ..K DIC S DIC="^PRCD(420.5,",DIC(0)="NZ",X=ECXUOFI D ^DIC
73 ..S ECXUOFI=$P($G(Y(0)),U,2)
74 ..S ECXTCOST=ECXCOST+ECXTCOST
75 ..S ECXDIV=$$GET1^DIQ(660,ECXDACT,8,"I")
76 ..S ECXDFN=$G(ECXP(660,ECXDACT,.02,"I"))
77 ..S ECXFORM=$G(ECXP(660,ECXDACT,11,"E"))_U_$G(ECXP(660,ECXDACT,11,"I"))
78 ..;Save for later
79 ..S ^TMP("ECXDSS",$J,CNT)=ECXPHCPC_U_ECHCDES_U_ECXHCPC_U_ECXQTY_U_ECXUOFI_U_ECXCOST
80 ..Q
81 .Q
82 Q
83HEADER ;print header
84 S PAGENUM=PAGENUM+1
85 S $P(LN,"-",132)=""
86 W @IOF
87 W !,"Cost by PSAS HCPC REPORT for "_$P($$SITE^VASITE,U,2)_" station "_$P($$SITE^VASITE,U,3),?120,"Page: ",PAGENUM
88 W !!,"Report for ",$$FMTE^XLFDT(ECSD1)," thru ",$$FMTE^XLFDT(ECED)
89 W !,?1,"PSAS HCPC",?15,"DESCRIPTION",?89,"HCPC",?98,"QTY",?104,"Unit of Issue",?126,"Cost"
90 W !?1,LN
91 Q
92 ;
93DETAIL ;Print detailed line
94 ;Input : ^TMP("ECXDSS",$J) full global reference
95 ; ECXPHCPC - PSAS HCPCS
96 ; ECXPHDESC - PSAS HCPC Description
97 ; ECXHCPC - HCPCS
98 ; ECXQTY - Quantity
99 ; ECXUOFI - Unit of issue
100 ; ECXCOST - Total cost
101 ;Output : None
102 S RECORD=0 F S RECORD=$O(^TMP("ECXDSS",$J,RECORD)) Q:'RECORD!(STOP) D
103 .S NODE=^TMP("ECXDSS",$J,RECORD)
104 .W !?1,$$RJ^XLFSTR($P(NODE,U,1),6),?15,$P(NODE,U,2),?89,$$RJ^XLFSTR($P(NODE,U,3),U,6),?99,$$RJ^XLFSTR($P(NODE,U,4),U,6),?107,$P(NODE,U,5)
105 .W ?122,"$"_$$RJ^XLFSTR($P($P(NODE,U,6),".",1),6)_"."_$$LJ^XLFSTR($P($P(NODE,U,6),".",2),2,0)
106 .I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
107 .Q
108 Q
109 ;
110TOTAL ;Report totals
111 N DASH
112 S $P(DASH,"=",15)=""
113 W !!,?118,DASH
114 W !?90,"Grand Total: ",?118,"$ "_$$RJ^XLFSTR($FNUMBER(ECXTCOST,",",2),11)
115 Q
116 ;
117WAIT ;End of page logic
118 ;Input ; None
119 ;Output ; STOP - Flag inidcating if printing should continue
120 ; 1 = Stop 0 = Continue
121 ;
122 S STOP=0
123 ;CRT - Prompt for continue
124 I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
125 .F Q:$Y>(IOSL-3) W !
126 .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
127 .S DIR(0)="E"
128 .D ^DIR
129 .S STOP=$S(Y'=1:1,1:0)
130 ;Background task - check taskman
131 S STOP=$$S^%ZTLOAD()
132 I STOP D
133 .W !,"*********************************************"
134 .W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
135 .W !,"*********************************************"
136 Q
137EXIT ;Kill temp global
138 K ^TMP("ECXDSS",$J)
139 Q
Note: See TracBrowser for help on using the repository browser.