| 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
|
|---|
