1 | ACKQPCX ;HCIOFO/AG - PCE Exception Report ; [ 03/27/99 10:02 AM ]
|
---|
2 | ;;3.0;QUASAR;**1**;Feb 11, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
4 | ;
|
---|
5 | OPTN ;Introduce option.
|
---|
6 | W @IOF
|
---|
7 | W !
|
---|
8 | W !?25,"QUASAR - PCE Exception Report",!
|
---|
9 | W !,"This option produces a report listing all the A&SP Clinic Visits that have been"
|
---|
10 | W !,"reported as an exception by PCE.",!
|
---|
11 | ;
|
---|
12 | ; get division
|
---|
13 | S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
|
---|
14 | DATES W !
|
---|
15 | D DTRANGE^ACKQRU G:$D(DIRUT) EXIT
|
---|
16 | I '$$V3DATE(ACKBD) K ACKBD,ACKXBD,ACKED,ACKXED G DATES
|
---|
17 | S ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
|
---|
18 | ;
|
---|
19 | DEV ; get device
|
---|
20 | W !!,"The right margin for this report is 80."
|
---|
21 | W !,"You can queue it to run at a later time.",!
|
---|
22 | K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
|
---|
23 | I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
|
---|
24 | ; queue selected
|
---|
25 | I $D(IO("Q")) D G EXIT
|
---|
26 | . K IO("Q")
|
---|
27 | . S ZTRTN="DQ^ACKQPCX",ZTDESC="QUASAR - PCE EXCEPTION REPORT"
|
---|
28 | . S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
|
---|
29 | ;
|
---|
30 | DQ ; Entry point when queued.
|
---|
31 | ; variables required at this point are:-
|
---|
32 | ; ACKDIV() - selected divisions
|
---|
33 | ; ACKBD - Begining Date Range
|
---|
34 | ; ACKED - End Date Range
|
---|
35 | ; ACKRDR - Date Heading
|
---|
36 | U IO
|
---|
37 | D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
|
---|
38 | K ^TMP("ACKQPCX",$J)
|
---|
39 | ;
|
---|
40 | ; walk down the visits using the exception date index
|
---|
41 | S ACKEXDT=ACKBD F S ACKEXDT=$O(^ACK(509850.6,"AEX",ACKEXDT)) Q:'ACKEXDT!(ACKEXDT>ACKED) D
|
---|
42 | . S ACKVIEN=0 F S ACKVIEN=$O(^ACK(509850.6,"AEX",ACKEXDT,ACKVIEN)) Q:'ACKVIEN D SORT
|
---|
43 | ;
|
---|
44 | ; now print the report
|
---|
45 | D PRINT
|
---|
46 | ;
|
---|
47 | EXIT ;ALWAYS EXIT HERE
|
---|
48 | K ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKCPT
|
---|
49 | K ACKSORT,ACKD,ACKED,ACKHDR2,ACKI,ACKLINE,ACKLR,ACKOOP,ACKP,ACKPC
|
---|
50 | K ACKPCP,ACKPG,ACKRDR,ACKSS,ACKSTAFF,ACKSTF,ACKT,ACKV,ACKVSC,ACKXBD
|
---|
51 | K ACKXED,ACKT2,ACKCT,ACKDIVX,ACKOK,ACKHDR,ACKDIV,ACKHDR5,ACKVDIV
|
---|
52 | K ACKSORT,ACKICDN,ACKTMP,ACKICD9,ACKTXT,ACKED,ACKBD,ACKRDR
|
---|
53 | K %DT,%I,%ZIS,%T,DIRUT,DTOUT,DUOUT,I,JJ,SS,X,Y,ZTDESC,ZTIO,ZTRTN
|
---|
54 | K ZTSAVE,ZTSK,^TMP("ACKQCX",$J),ACKXBD,ACKXED,NEWCLN,VADM
|
---|
55 | K ACKVIEN,ACKDT,ACKVERR,ACKDTEX,ACKEXDT,ACKTM,ACKPAT,ACKPATSS,ACKPATNM
|
---|
56 | W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
---|
57 | Q
|
---|
58 | SORT ; add the exception visit to ^TMP in sort order.
|
---|
59 | ;
|
---|
60 | ; check visit is for a selected Division
|
---|
61 | S ACKVDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I") ; division
|
---|
62 | I '$D(ACKDIV(+ACKVDIV)) Q
|
---|
63 | ;
|
---|
64 | ; unpack data items needed for sorting
|
---|
65 | S ACKDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I") ; visit date
|
---|
66 | S ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I") ; Appointment time
|
---|
67 | S ACKCLN=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"I") ; clinic
|
---|
68 | ;
|
---|
69 | ; file in temp file
|
---|
70 | S ^TMP("ACKQPCX",$J,"SORT",+ACKVDIV,+ACKCLN,+ACKDT,+ACKTM,+ACKVIEN)=""
|
---|
71 | ;
|
---|
72 | ; end of sort
|
---|
73 | Q
|
---|
74 | PRINT ; print the report for each Division
|
---|
75 | S ACKVDIV=""
|
---|
76 | I '$D(^TMP("ACKQPCX",$J,"SORT")) D HDR W !!,"No data found for report specifications.",!! D:$E(IOST)="C" PAUSE^ACKQUTL Q
|
---|
77 | F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV="" D PRINT2 Q:$D(DIRUT)
|
---|
78 | Q
|
---|
79 | PRINT2 ; print for a single division
|
---|
80 | I '$D(^TMP("ACKQPCX",$J,"SORT",ACKVDIV)) D Q
|
---|
81 | . D HDR W !!,"No data found for report specifications.",!!
|
---|
82 | . D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
83 | D HDR
|
---|
84 | ; walk down the clinics for the Division
|
---|
85 | S ACKCLN=""
|
---|
86 | F S ACKCLN=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN)) Q:ACKCLN="" D Q:$D(DIRUT)
|
---|
87 | . S ACKDT="",NEWCLN=1
|
---|
88 | . F S ACKDT=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN,ACKDT)) Q:ACKDT="" D Q:$D(DIRUT)
|
---|
89 | . . S ACKTM=""
|
---|
90 | . . F S ACKTM=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN,ACKDT,ACKTM)) Q:ACKTM="" D Q:$D(DIRUT)
|
---|
91 | . . . S ACKVIEN=""
|
---|
92 | . . . F S ACKVIEN=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN,ACKDT,ACKTM,ACKVIEN)) Q:ACKVIEN="" D Q:$D(DIRUT)
|
---|
93 | . . . . D PRINTV
|
---|
94 | Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
95 | ;
|
---|
96 | ; end of printing for a division
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | PRINTV ; Print a Visit
|
---|
100 | K ^TMP("ACKQPCX",$J,"VISIT")
|
---|
101 | S ACKVERR=$NA(^TMP("ACKQPCX",$J,"VISIT"))
|
---|
102 | D PCEERR^ACKQUTL3(ACKVIEN,ACKVERR,0,IOM-10)
|
---|
103 | ;
|
---|
104 | ; determine whether page throw is required
|
---|
105 | S LN=$S(NEWCLN:2,1:0)+3+$S(@ACKVERR:@ACKVERR,1:2)
|
---|
106 | ; W "($Y=" W $Y,",LN=",LN,")"
|
---|
107 | I $Y>(IOSL-LN-2) S Y=$Y D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
|
---|
108 | ;
|
---|
109 | W:NEWLN ! S NEWLN=1
|
---|
110 | ; if new clinic then print clinic name
|
---|
111 | I NEWCLN W !,"Clinic: ",$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E"),! S NEWCLN=0
|
---|
112 | ;
|
---|
113 | ; get patient data
|
---|
114 | S (ACKPAT,DFN)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I")
|
---|
115 | D DEM^VADPT
|
---|
116 | S ACKPATNM=VADM(1),ACKPATSS=$P(VADM(2),U,2)
|
---|
117 | ;
|
---|
118 | ; print visit header
|
---|
119 | S Y=ACKDT D DD^%DT S ACKDTEX=Y
|
---|
120 | W !,?5,"Visit Date: ",ACKDTEX
|
---|
121 | W ?40,"Patient: ",$E(ACKPATNM,1,40)
|
---|
122 | W !,?4,"Appnt. Time: ",$$FMT^ACKQUTL6(ACKTM,0)
|
---|
123 | W ?40," SSN: ",ACKPATSS
|
---|
124 | ;
|
---|
125 | ; print errors
|
---|
126 | I @ACKVERR F LN=1:1:@ACKVERR W !,?10,@ACKVERR@(LN)
|
---|
127 | I '@ACKVERR D
|
---|
128 | . W !,?10,"Last Edit in QSR: ",$$GET1^DIQ(509850.6,ACKVIEN_",",140,"E")
|
---|
129 | . W !,?10,"Last Sent to PCE: ",$$GET1^DIQ(509850.6,ACKVIEN_",",135,"E")
|
---|
130 | ;
|
---|
131 | ; end of printing a visit
|
---|
132 | Q
|
---|
133 | ;
|
---|
134 | HDR ;
|
---|
135 | W:($E(IOST)="C")!(ACKPG>0) @IOF
|
---|
136 | S ACKPG=ACKPG+1
|
---|
137 | W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
|
---|
138 | W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
|
---|
139 | W ! D CNTR^ACKQUTL("PCE Exception Report")
|
---|
140 | I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV)_" "_ACKRDR)
|
---|
141 | S X="",$P(X,"-",IOM)="-" W !,X
|
---|
142 | S NEWLN=0
|
---|
143 | Q
|
---|
144 | ;
|
---|
145 | DIVNAME(ACKVDIV) ; get division name
|
---|
146 | Q $$GET1^DIQ(509850.83,ACKVDIV_",1",.01,"E")
|
---|
147 | ;
|
---|
148 | V3DATE(ACKBD) ;
|
---|
149 | N ACKA,ACKB,X,Y,X1,X2,%T,%H,%
|
---|
150 | S ACKA=""
|
---|
151 | S ACKA=$O(^DIC(9.4,"B","QUASAR",ACKA))
|
---|
152 | I ACKA="" Q 1
|
---|
153 | S ACKB=""
|
---|
154 | I '$D(^DIC(9.4,ACKA,22,"B","3.0")) Q 1
|
---|
155 | S ACKB=$O(^DIC(9.4,ACKA,22,"B","3.0",ACKB))
|
---|
156 | I ACKB="" Q 1
|
---|
157 | I '$D(^DIC(9.4,ACKA,22,ACKB,0)) Q 1
|
---|
158 | S Y=$P(^DIC(9.4,ACKA,22,ACKB,0),"^",3)
|
---|
159 | I Y="" Q 1
|
---|
160 | S Y=$P(Y,".",1)
|
---|
161 | S X1=ACKBD,X2="1" D C^%DTC S X=$P(X,".",1)
|
---|
162 | I X>Y Q 1
|
---|
163 | D DD^%DT
|
---|
164 | T W !!,"Warning - You are running a report using a start date that falls either on or before the installation of version 3.0 of Quasar."
|
---|
165 | W !!,"Quasar version 3.0 was installed on - ",Y
|
---|
166 | W !!,"Note that all PCE related functionality was developed within Quasar version 3.0."
|
---|
167 | W !,"It is recommended that this report be run using start a date that falls after the installation date.",!
|
---|
168 | ;
|
---|
169 | N DIR,DUOUT,DTOUT,DIRUT
|
---|
170 | OK2 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to Continue "
|
---|
171 | S DIR("?")="Answer YES to continue running the report or NO to quit."
|
---|
172 | D ^DIR
|
---|
173 | I Y?1"^"1.E W !,"Jumping not allowed.",! G OK2
|
---|
174 | S:$D(DIRUT) Y=0
|
---|
175 | S:$D(DTOUT) Y=0
|
---|
176 | Q Y
|
---|