source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXAMTL.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1ECXAMTL ;ALB/JAM - MTL Extract Audit Report; May 24, 1999
2 ;;3.0;DSS EXTRACTS;**24,44**;May 24, 1999
3EN ;entry point for MTL extract audit report
4 N %X,%Y
5 ;ecxaud=0 for 'extract' audit
6 S ECXERR=0
7 S ECXHEAD="MTL",ECXAUD=0
8 W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
9 ;select extract
10 D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD) I ECXERR D Q
11 . K ECXHEAD,ECXAUD,ECXERR
12 ;get facility/division
13 S ECXALL=1
14 D MTL^ECXDVSN2(.ECXDIV,ECXALL,.ECXERR) I ECXERR D AUDIT^ECXKILL Q
15 ;select output device and queue report if requested
16 S ECXPGM="PROCESS^ECXAMTL",ECXDESC="MTL Extract Audit Report"
17 S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")=""
18 S ECXSAVE("ECXARRAY(")="" W !
19 D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
20 I ECXSAVE("POP")=1 D Q
21 . W !!,?5,"Try again later... exiting.",!
22 . D AUDIT^ECXKILL
23 I ECXSAVE("ZTSK")=0 D
24 . K ECXSAVE,ECXPGM,ECXDESC
25 . D PROCESS^ECXAMTL
26 I IO'=IO(0) D ^%ZISC
27 D HOME^%ZIS
28 D AUDIT^ECXKILL
29 Q
30PROCESS ;process data in file #727.812
31 N DAY,MTLDAT,MTLDAT1,SSN,NAME,EXN,IEN,ASI,SPC,TSTNAM,PROV,DATND,TSTSC
32 N NODE
33 K ^TMP($J,"ECXMTL") S EXN=ECXARRAY("EXTRACT")
34 ;set start and end date in interal format
35 S X=ECXARRAY("START") S %DT="" D ^%DT S ECXSTART=Y
36 S X=ECXARRAY("END") D ^%DT S ECXEND=Y
37 ;get run date in external format
38 D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
39 ;get records for specified date range within extract
40 S IEN=0 F S IEN=$O(^ECX(727.812,"AC",EXN,IEN)) Q:'IEN D
41 . S MTLDAT=^ECX(727.812,IEN,0),MTLDAT1=$G(^ECX(727.812,IEN,1))
42 . ;convert date to fileman internal format
43 . S DAY=$P(MTLDAT,U,9),$E(DAY,1,2)=$E(DAY,1,2)-17 Q:$L(DAY)<7
44 . I DAY<ECXSTART!(DAY>ECXEND) Q
45 . S SSN=$P(MTLDAT,U,6),NAME=$P(MTLDAT,U,7),TSTNAM=$P(MTLDAT,U,21)
46 . S PROV=$P(MTLDAT,U,18)
47 . S:PROV'="" PROV=$$GET1^DIQ(200,$E(PROV,2,999),.01,"I")
48 . S TSTSC=$P(MTLDAT,U,25),ASI=$P(MTLDAT1,U,5),SPC=$P(MTLDAT1,U,6)
49 . ;determine next level for ^TMP($J,"ECXMTL",
50 . Q:TSTNAM="" S NODE=TSTNAM I TSTNAM'="ASI",TSTNAM'="GAF" S NODE="PI"
51 . ;data to be stored at node in ^TMP($J,"ECXMTL,NODE
52 . S DATND=$S(NODE="ASI":ASI_U_SPC,NODE="GAF":TSTSC_U_PROV,1:"")
53 . ;store data in ^TMP($J,"ECXMTL",NODE
54 . I NODE="PI" D Q
55 . . I '$D(^TMP($J,"ECXMTL",NODE,TSTNAM,NAME,SSN,DAY)) D
56 . . . S ^TMP($J,"ECXMTL",NODE,TSTNAM,NAME,SSN,DAY)=DATND
57 . . . S ^TMP($J,"ECXMTL",NODE,TSTNAM)=$G(^TMP($J,"ECXMTL",NODE,TSTNAM))+1
58 . I '$D(^TMP($J,"ECXMTL",NODE,NAME,SSN,DAY)) D
59 . . S ^TMP($J,"ECXMTL",NODE,NAME,SSN,DAY)=DATND
60 D PRINT,AUDIT^ECXKILL
61 Q
62PRINT ;print the MTL audit report
63 N ND,NAM,SSN,DAY,PITOT,GAFTOT,ASI,INSTOT,CNT,DIV,QFL,LN,I,CLS,SPC,ASISP
64 N PG,ASITOT,ASISPTOT
65 U IO
66 I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
67 S (ASITOT,ASISPTOT,QFL,PG,CNT)=0,$P(LN,"-",74)="",DIV=$O(ECXDIV(""))
68 ;
69 ;- Added new class, ASI-MV, per MH patch YS*5.01*67
70 F I=1:1:4,999 S (ASI(I),ASISP(I))=0 D
71 . S ASI(I,0)=$S(I=1:"Full",I=2:"Lite",I=3:"Follow-up",I=4:"For ASI-MV",1:"Unspecified")
72 . S ASISP(I,0)=$S(I=1:"Terminated",I=2:"Refused",I=3:"Unable",1:"Unspecified")
73 S ASISP(0)=0,ASISP(0,0)="Completed" D HEADER
74 S ND="" F S ND=$O(^TMP($J,"ECXMTL",ND)) Q:ND="" D I QFL Q
75 . S CNT=CNT+1 D H1 S NAM="" I ($Y+3)>IOSL D HEADER I QFL Q
76 . I ND="PI" D Q
77 . . F S NAM=$O(^TMP($J,"ECXMTL",ND,NAM)) Q:NAM="" D I QFL Q
78 . . . S INSTOT=^TMP($J,"ECXMTL",ND,NAM)
79 . . . D:($Y+3)>IOSL HEADER Q:QFL W ?5,NAM,?32,$J(INSTOT,8),!
80 . . . S PITOT=$G(PITOT)+INSTOT
81 . . I ($Y+3)>IOSL D HEADER I QFL Q
82 . . W ?5,LN,!,?5,"Total",?30,$J(PITOT,10),!
83 . F S NAM=$O(^TMP($J,"ECXMTL",ND,NAM)) Q:NAM="" S SSN="" D I QFL Q
84 . .F S SSN=$O(^TMP($J,"ECXMTL",ND,NAM,SSN)) Q:SSN="" S DAY="" D Q:QFL
85 . . . F S DAY=$O(^TMP($J,"ECXMTL",ND,NAM,SSN,DAY)) Q:DAY="" D P1 Q:QFL
86 . I QFL Q
87 . ;print GAF total
88 . I ND="GAF" D Q
89 . . D:($Y+3)>IOSL HEADER Q:QFL W ?5,LN,!,?5,"Total: ",GAFTOT,!
90 . ;print ASI totals
91 . I ND="ASI" D Q
92 . . D:($Y+3)>IOSL HEADER Q:QFL W ?5,LN,! S (CLS,SPC)=-1
93 . . F I=1:1:5 D Q:(CLS="")&(SPC="") I QFL Q
94 . . . I ($Y+3)>IOSL D HEADER I QFL Q
95 . . . I CLS'="" S CLS=$O(ASI(CLS)) D:CLS'=""
96 . . . . W ?29,$J(ASI(CLS),8)," ",ASI(CLS,0)
97 . . . . S ASITOT=ASITOT+ASI(CLS)
98 . . . I SPC'="" S SPC=$O(ASISP(SPC)) D:SPC'=""
99 . . . . W ?50,$J(ASISP(SPC),8)," ",ASISP(SPC,0) D
100 . . . . S ASISPTOT=ASISPTOT+ASISP(SPC)
101 . . . W !
102 . . Q:QFL W ?5,LN,!,?27,$J(ASITOT,10),?48,$J(ASISPTOT,10)," ","Total"
103 Q
104P1 ;print ASI and GAF records
105 N DATND,DATE
106 S DATND=^TMP($J,"ECXMTL",ND,NAM,SSN,DAY)
107 S DATE=$E(DAY,4,5)_"/"_$E(DAY,6,7)_"/"_($E(DAY)+17)_$E(DAY,2,3)
108 D:($Y+3)>IOSL HEADER Q:QFL W ?5,NAM,?14,$E(SSN,$L(SSN)-3,$L(SSN))
109 I ND="ASI" D Q
110 . S CLS=$P(DATND,U),SPC=$P(DATND,U,2)
111 . W ?21,DATE,?36,$S(CLS=1:"Full",CLS=2:"Lite",CLS=3:"F-up",CLS=4:"ASI-MV",1:""),?57,SPC,!
112 . S:CLS="" CLS=999 S:SPC="" SPC=999 S:SPC="N" SPC=0
113 . S ASI(CLS)=$G(ASI(CLS))+1,ASISP(SPC)=$G(ASISP(SPC))+1
114 I ND="GAF" D Q
115 . W ?21,DATE,?36,$P(DATND,U,2),!
116 . S GAFTOT=$G(GAFTOT)+1
117 Q
118HEADER ;header and page control
119 N JJ,SS
120 I $E(IOST)="C" D I QFL Q
121 . S SS=22-$Y F JJ=1:1:SS W !
122 . I PG S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFL=1
123 W:PG!($E(IOST)="C") @IOF S PG=PG+1
124 W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
125 W !,"DSS Extract Log #: "_ECXARRAY("EXTRACT")
126 W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
127 W !,"Report Run Date/Time: "_ECXRUN
128 I $P(ECXDIV(DIV),U)="" D
129 . S $P(ECXDIV(DIV),U)=$P(ECXDIV(DIV),U,3)
130 . I $P(ECXDIV(DIV),U)="" S $P(ECXDIV(DIV),U)="Unknown"
131 W !,"Facility: "_$P(ECXDIV(DIV),U)
132 W " ("_$P(ECXDIV(DIV),U,4)_")",?68,"Page: "_PG
133H1 I $G(ND)'="" D
134 . W !!,CNT,".",?5
135 . I ND="PI" W "Psych Instruments segment",!! Q
136 . W ND," segment",!!
137 . W ?5,"Name",?14,"SSN",?21
138 . I ND="ASI" W "Interview",?36,"Class",?54,"Special"
139 . I ND="GAF" W "Date",?36,"Clinician"
140 . W !,?5,LN,!
141 Q
Note: See TracBrowser for help on using the repository browser.