source: WorldVistAEHR/trunk/r/QUASAR-ACKQ/ACKQPCX.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: 6.2 KB
RevLine 
[613]1ACKQPCX ;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 ;
5OPTN ;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
14DATES 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 ;
19DEV ; 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 ;
30DQ ; 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 ;
47EXIT ;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
58SORT ; 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
74PRINT ; 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
79PRINT2 ; 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 ;
99PRINTV ; 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 ;
134HDR ;
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 ;
145DIVNAME(ACKVDIV) ; get division name
146 Q $$GET1^DIQ(509850.83,ACKVDIV_",1",.01,"E")
147 ;
148V3DATE(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
164T 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
170OK2 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
Note: See TracBrowser for help on using the repository browser.