source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXAPRO2.m@ 691

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1ECXAPRO2 ;ALB/JAP - PRO Extract Audit Report (cont) ; Nov 16, 1998
2 ;;3.0;DSS EXTRACTS;**9,21,39**;Dec 22, 1997
3 ;
4ASK ;further detail needed?
5 K X,Y
6 W !
7 S DIR(0)="Y",DIR("A")="Do you want to see details on this audit report",DIR("B")="NO"
8 D ^DIR K DIR
9 Q:($G(Y)=0)!$D(DUOUT)!($D(DTOUT))
10 ;allow user to expand as many lines as needed
11 F D ASK2 Q:$D(DUOUT)!($D(DTOUT))
12 Q
13 ;
14ASK2 ;select nppd group to be expanded
15 D CODE
16 W @IOF,!
17 W !,?5,"1. WHEELCHAIRS AND ACCESSORIES"
18 W !,?5,"2. ARTIFICAL LEGS"
19 W !,?5,"3. ARTIFICAL ARMS AND TERMINAL DEVICES"
20 W !,?5,"4. BRACES AND ORTHOTICS"
21 W !,?5,"5. SHOES/ORTHOTICS"
22 W !,?5,"6. NEUROSENSORY AIDS"
23 W !,?5,"7. RESTORATIONS"
24 W !,?5,"8. OXYGEN AND RESPIRATIORY"
25 W !,?5,"9. MEDICAL EQUIPMENT, MISC., ALL OTHER NEW"
26 W !,?5,"10. REPAIR",!!
27 S DIR(0)="N^1:10:0"
28 S DIR("A")="Select NPPD Group "
29 D ^DIR K DIR
30 Q:$D(DUOUT)!($D(DTOUT))
31 D ASK3(Y)
32 Q:$D(DTOUT)
33 K DIRUT,DTOUT,DUOUT
34 G ASK2
35 Q
36 ;
37ASK3(ECXY) ;select nppd line item
38 N BR,BRC,CODE
39 S BR=0,BRC=0 K CODE W @IOF
40 F S BR=$O(^TMP($J,"RMPRCODE",BR)) Q:BR="" I $L(BR)>3 D
41 .I $E(BR,1,1)=ECXY S BRC=BRC+1 W !?5,BRC_".",?10,BR,?18,^TMP($J,"RMPRCODE",BR) S CODE(BRC,BR)=""
42 .I ($E(BR,1,1)="R")&(ECXY=10) S BRC=BRC+1 W !?5,BRC_".",?10,BR,?18,^TMP($J,"RMPRCODE",BR) S CODE(BRC,BR)=""
43 W !
44 S DIR(0)="N^1:"_BRC_":0"
45 S DIR("A")="Select NPPD Line "
46 D ^DIR K DIR
47 Q:$D(DUOUT)!($D(DTOUT))
48 S ECXCODE="",ECXCODE=$O(CODE(Y,ECXCODE))
49 S ECXPGM="TASK^ECXAPRO",ECXDESC="PRO Extract Audit Detail"
50 S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")="",ECXSAVE("ECXREPT")="",ECXSAVE("ECXPRIME")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXCODE")=""
51 W !
52 ;determine output device and queue if requested
53 D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE) I ECXSAVE("POP")=1 D Q
54 .W !!,?5,"Try again later... exiting.",!
55 I ECXSAVE("ZTSK")=0 D
56 .K ECXSAVE,ECXPGM,ECXDESC
57 .I '$D(^TMP($J,"RMPRGN")) D PROCESS^ECXAPRO
58 .D DISP
59 I $D(IO(0)) I IO(0)'=IO D ^%ZISC
60 D HOME^%ZIS
61 Q
62 ;
63CODE ;setup nppd codes
64 ;intended to duplicate code^rmprn63
65 N NULINE
66 Q:$D(^TMP($J,"RMPRCODE"))
67 F I=1:1 S NULINE=$P($T(TEXT+I^ECXAPRO3),";;",2) Q:NULINE["QUIT" D
68 .S ^TMP($J,"RMPRCODE",$P(NULINE,";",1))=$P(NULINE,";",2)
69 Q
70 ;
71DISP ;display all records within nppd code group
72 ;based on desp^rmprn6pl
73 N JJ,SS,LN,PG,COST,DATE,DESC,HCPCS,LOC,PTNAM,QFLG,QTY,RDX,RDXX,SSN,TYPE,DIR,DIRUT,DTOUT,DUOUT
74 U IO
75 S (QFLG,PG)=0,$P(LN,"-",80)=""
76 D HEADER
77 I '$D(^TMP($J,ECXCODE)) D Q
78 .W !,?14,"No data available.",!
79 .I $E(IOST)="C",'QFLG D
80 ..S SS=22-$Y F JJ=1:1:SS W !
81 ..S DIR(0)="E" D ^DIR K DIR
82 S RDX=0
83 F S RDX=$O(^TMP($J,ECXCODE,RDX)) Q:RDX'>0 Q:QFLG D
84 .S RDXX=^TMP($J,ECXCODE,RDX)
85 .S PTNAM=$P(RDXX,U,9),SSN=$P(RDXX,U,10)
86 .D:($Y+3>IOSL) HEADER Q:QFLG
87 .S TYPE=$P(RDXX,U,1),TYPE=$S(TYPE="X":"R",1:"I")_" "_$P(RDXX,U,2)
88 .S QTY=+$P(RDXX,U,3),COST=$P(RDXX,U,4),HCPCS=$P(RDXX,U,7),DESC=$P(RDXX,U,8),DATE=$P(RDXX,U,11),LOC=$P(RDXX,U,12)
89 .W !,PTNAM,?6,SSN,?13,HCPCS,?20,QTY,?30,TYPE,?36,COST,?45,DATE,?52,DESC,?74,LOC
90 I $E(IOST)="C",'QFLG D
91 .S SS=22-$Y F JJ=1:1:SS W !
92 .S DIR(0)="E" D ^DIR K DIR
93 Q
94 ;
95HEADER ;header and page control
96 I $E(IOST)="C" D
97 .S SS=22-$Y F JJ=1:1:SS W !
98 .I PG>0 S DIR(0)="E" D ^DIR K DIR S:'Y QFLG=1
99 Q:QFLG
100 W:$Y!($E(IOST)="C") @IOF S PG=PG+1
101 W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report Detail",?72,"Page ",PG
102 W !,"DSS Extract Log #: "_ECXEXT
103 W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
104 I ECXALL=1 W !,"Station: "_$P(ECXDIV,U,2)_" ("_$P(ECXDIV,U,3)_")"
105 I ECXALL=0 W !,"Division: "_$P(ECXDIV,U,2)_" ("_$P(ECXDIV,U,3)_")"
106 W !,"Report Run Date/Time: "_ECXRUN
107 W !,LN,!,ECXCODE," -- ",^TMP($J,"RMPRCODE",ECXCODE)
108 W !,"NAME",?6,"SSN",?13,"HCPCS",?20,"QTY",?30,"TYPE",?36,"COST",?45,"DATE",?52,"HCPCS DESC",?74,"STN #"
109 W !,LN,!
110 Q
Note: See TracBrowser for help on using the repository browser.