ACKQPCX ;HCIOFO/AG - PCE Exception Report ; [ 03/27/99 10:02 AM ]
;;3.0;QUASAR;**1**;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
OPTN ;Introduce option.
W @IOF
W !
W !?25,"QUASAR - PCE Exception Report",!
W !,"This option produces a report listing all the A&SP Clinic Visits that have been"
W !,"reported as an exception by PCE.",!
;
; get division
S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
DATES W !
D DTRANGE^ACKQRU G:$D(DIRUT) EXIT
I '$$V3DATE(ACKBD) K ACKBD,ACKXBD,ACKED,ACKXED G DATES
S ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
;
DEV ; get device
W !!,"The right margin for this report is 80."
W !,"You can queue it to run at a later time.",!
K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
; queue selected
I $D(IO("Q")) D G EXIT
. K IO("Q")
. S ZTRTN="DQ^ACKQPCX",ZTDESC="QUASAR - PCE EXCEPTION REPORT"
. S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
;
DQ ; Entry point when queued.
; variables required at this point are:-
; ACKDIV() - selected divisions
; ACKBD - Begining Date Range
; ACKED - End Date Range
; ACKRDR - Date Heading
U IO
D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
K ^TMP("ACKQPCX",$J)
;
; walk down the visits using the exception date index
S ACKEXDT=ACKBD F S ACKEXDT=$O(^ACK(509850.6,"AEX",ACKEXDT)) Q:'ACKEXDT!(ACKEXDT>ACKED) D
. S ACKVIEN=0 F S ACKVIEN=$O(^ACK(509850.6,"AEX",ACKEXDT,ACKVIEN)) Q:'ACKVIEN D SORT
;
; now print the report
D PRINT
;
EXIT ;ALWAYS EXIT HERE
K ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKCPT
K ACKSORT,ACKD,ACKED,ACKHDR2,ACKI,ACKLINE,ACKLR,ACKOOP,ACKP,ACKPC
K ACKPCP,ACKPG,ACKRDR,ACKSS,ACKSTAFF,ACKSTF,ACKT,ACKV,ACKVSC,ACKXBD
K ACKXED,ACKT2,ACKCT,ACKDIVX,ACKOK,ACKHDR,ACKDIV,ACKHDR5,ACKVDIV
K ACKSORT,ACKICDN,ACKTMP,ACKICD9,ACKTXT,ACKED,ACKBD,ACKRDR
K %DT,%I,%ZIS,%T,DIRUT,DTOUT,DUOUT,I,JJ,SS,X,Y,ZTDESC,ZTIO,ZTRTN
K ZTSAVE,ZTSK,^TMP("ACKQCX",$J),ACKXBD,ACKXED,NEWCLN,VADM
K ACKVIEN,ACKDT,ACKVERR,ACKDTEX,ACKEXDT,ACKTM,ACKPAT,ACKPATSS,ACKPATNM
W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
SORT ; add the exception visit to ^TMP in sort order.
;
; check visit is for a selected Division
S ACKVDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I") ; division
I '$D(ACKDIV(+ACKVDIV)) Q
;
; unpack data items needed for sorting
S ACKDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I") ; visit date
S ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I") ; Appointment time
S ACKCLN=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"I") ; clinic
;
; file in temp file
S ^TMP("ACKQPCX",$J,"SORT",+ACKVDIV,+ACKCLN,+ACKDT,+ACKTM,+ACKVIEN)=""
;
; end of sort
Q
PRINT ; print the report for each Division
S ACKVDIV=""
I '$D(^TMP("ACKQPCX",$J,"SORT")) D HDR W !!,"No data found for report specifications.",!! D:$E(IOST)="C" PAUSE^ACKQUTL Q
F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV="" D PRINT2 Q:$D(DIRUT)
Q
PRINT2 ; print for a single division
I '$D(^TMP("ACKQPCX",$J,"SORT",ACKVDIV)) D Q
. D HDR W !!,"No data found for report specifications.",!!
. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
D HDR
; walk down the clinics for the Division
S ACKCLN=""
F S ACKCLN=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN)) Q:ACKCLN="" D Q:$D(DIRUT)
. S ACKDT="",NEWCLN=1
. F S ACKDT=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN,ACKDT)) Q:ACKDT="" D Q:$D(DIRUT)
. . S ACKTM=""
. . F S ACKTM=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN,ACKDT,ACKTM)) Q:ACKTM="" D Q:$D(DIRUT)
. . . S ACKVIEN=""
. . . F S ACKVIEN=$O(^TMP("ACKQPCX",$J,"SORT",ACKVDIV,ACKCLN,ACKDT,ACKTM,ACKVIEN)) Q:ACKVIEN="" D Q:$D(DIRUT)
. . . . D PRINTV
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
;
; end of printing for a division
Q
;
PRINTV ; Print a Visit
K ^TMP("ACKQPCX",$J,"VISIT")
S ACKVERR=$NA(^TMP("ACKQPCX",$J,"VISIT"))
D PCEERR^ACKQUTL3(ACKVIEN,ACKVERR,0,IOM-10)
;
; determine whether page throw is required
S LN=$S(NEWCLN:2,1:0)+3+$S(@ACKVERR:@ACKVERR,1:2)
; W "($Y=" W $Y,",LN=",LN,")"
I $Y>(IOSL-LN-2) S Y=$Y D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
;
W:NEWLN ! S NEWLN=1
; if new clinic then print clinic name
I NEWCLN W !,"Clinic: ",$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E"),! S NEWCLN=0
;
; get patient data
S (ACKPAT,DFN)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I")
D DEM^VADPT
S ACKPATNM=VADM(1),ACKPATSS=$P(VADM(2),U,2)
;
; print visit header
S Y=ACKDT D DD^%DT S ACKDTEX=Y
W !,?5,"Visit Date: ",ACKDTEX
W ?40,"Patient: ",$E(ACKPATNM,1,40)
W !,?4,"Appnt. Time: ",$$FMT^ACKQUTL6(ACKTM,0)
W ?40," SSN: ",ACKPATSS
;
; print errors
I @ACKVERR F LN=1:1:@ACKVERR W !,?10,@ACKVERR@(LN)
I '@ACKVERR D
. W !,?10,"Last Edit in QSR: ",$$GET1^DIQ(509850.6,ACKVIEN_",",140,"E")
. W !,?10,"Last Sent to PCE: ",$$GET1^DIQ(509850.6,ACKVIEN_",",135,"E")
;
; end of printing a visit
Q
;
HDR ;
W:($E(IOST)="C")!(ACKPG>0) @IOF
S ACKPG=ACKPG+1
W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
W ! D CNTR^ACKQUTL("PCE Exception Report")
I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV)_" "_ACKRDR)
S X="",$P(X,"-",IOM)="-" W !,X
S NEWLN=0
Q
;
DIVNAME(ACKVDIV) ; get division name
Q $$GET1^DIQ(509850.83,ACKVDIV_",1",.01,"E")
;
V3DATE(ACKBD) ;
N ACKA,ACKB,X,Y,X1,X2,%T,%H,%
S ACKA=""
S ACKA=$O(^DIC(9.4,"B","QUASAR",ACKA))
I ACKA="" Q 1
S ACKB=""
I '$D(^DIC(9.4,ACKA,22,"B","3.0")) Q 1
S ACKB=$O(^DIC(9.4,ACKA,22,"B","3.0",ACKB))
I ACKB="" Q 1
I '$D(^DIC(9.4,ACKA,22,ACKB,0)) Q 1
S Y=$P(^DIC(9.4,ACKA,22,ACKB,0),"^",3)
I Y="" Q 1
S Y=$P(Y,".",1)
S X1=ACKBD,X2="1" D C^%DTC S X=$P(X,".",1)
I X>Y Q 1
D DD^%DT
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."
W !!,"Quasar version 3.0 was installed on - ",Y
W !!,"Note that all PCE related functionality was developed within Quasar version 3.0."
W !,"It is recommended that this report be run using start a date that falls after the installation date.",!
;
N DIR,DUOUT,DTOUT,DIRUT
OK2 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to Continue "
S DIR("?")="Answer YES to continue running the report or NO to quit."
D ^DIR
I Y?1"^"1.E W !,"Jumping not allowed.",! G OK2
S:$D(DIRUT) Y=0
S:$D(DTOUT) Y=0
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQPCX 6538 printed Nov 22, 2024@17:42:27 Page 2
ACKQPCX ;HCIOFO/AG - PCE Exception Report ; [ 03/27/99 10:02 AM ]
+1 ;;3.0;QUASAR;**1**;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
OPTN ;Introduce option.
+1 WRITE @IOF
+2 WRITE !
+3 WRITE !?25,"QUASAR - PCE Exception Report",!
+4 WRITE !,"This option produces a report listing all the A&SP Clinic Visits that have been"
+5 WRITE !,"reported as an exception by PCE.",!
+6 ;
+7 ; get division
+8 SET ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI")
if +ACKDIV=0
GOTO EXIT
DATES WRITE !
+1 DO DTRANGE^ACKQRU
if $DATA(DIRUT)
GOTO EXIT
+2 IF '$$V3DATE(ACKBD)
KILL ACKBD,ACKXBD,ACKED,ACKXED
GOTO DATES
+3 SET ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
+4 ;
DEV ; get device
+1 WRITE !!,"The right margin for this report is 80."
+2 WRITE !,"You can queue it to run at a later time.",!
+3 KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
+4 IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED."
GOTO EXIT
+5 ; queue selected
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 KILL IO("Q")
+8 SET ZTRTN="DQ^ACKQPCX"
SET ZTDESC="QUASAR - PCE EXCEPTION REPORT"
+9 SET ZTSAVE("ACK*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+10 ;
DQ ; Entry point when queued.
+1 ; variables required at this point are:-
+2 ; ACKDIV() - selected divisions
+3 ; ACKBD - Begining Date Range
+4 ; ACKED - End Date Range
+5 ; ACKRDR - Date Heading
+6 USE IO
+7 DO NOW^%DTC
SET ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
SET ACKPG=0
+8 KILL ^TMP("ACKQPCX",$JOB)
+9 ;
+10 ; walk down the visits using the exception date index
+11 SET ACKEXDT=ACKBD
FOR
SET ACKEXDT=$ORDER(^ACK(509850.6,"AEX",ACKEXDT))
if 'ACKEXDT!(ACKEXDT>ACKED)
QUIT
Begin DoDot:1
+12 SET ACKVIEN=0
FOR
SET ACKVIEN=$ORDER(^ACK(509850.6,"AEX",ACKEXDT,ACKVIEN))
if 'ACKVIEN
QUIT
DO SORT
End DoDot:1
+13 ;
+14 ; now print the report
+15 DO PRINT
+16 ;
EXIT ;ALWAYS EXIT HERE
+1 KILL ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKCPT
+2 KILL ACKSORT,ACKD,ACKED,ACKHDR2,ACKI,ACKLINE,ACKLR,ACKOOP,ACKP,ACKPC
+3 KILL ACKPCP,ACKPG,ACKRDR,ACKSS,ACKSTAFF,ACKSTF,ACKT,ACKV,ACKVSC,ACKXBD
+4 KILL ACKXED,ACKT2,ACKCT,ACKDIVX,ACKOK,ACKHDR,ACKDIV,ACKHDR5,ACKVDIV
+5 KILL ACKSORT,ACKICDN,ACKTMP,ACKICD9,ACKTXT,ACKED,ACKBD,ACKRDR
+6 KILL %DT,%I,%ZIS,%T,DIRUT,DTOUT,DUOUT,I,JJ,SS,X,Y,ZTDESC,ZTIO,ZTRTN
+7 KILL ZTSAVE,ZTSK,^TMP("ACKQCX",$JOB),ACKXBD,ACKXED,NEWCLN,VADM
+8 KILL ACKVIEN,ACKDT,ACKVERR,ACKDTEX,ACKEXDT,ACKTM,ACKPAT,ACKPATSS,ACKPATNM
+9 if $EXTRACT(IOST)="C"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+10 QUIT
SORT ; add the exception visit to ^TMP in sort order.
+1 ;
+2 ; check visit is for a selected Division
+3 ; division
SET ACKVDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I")
+4 IF '$DATA(ACKDIV(+ACKVDIV))
QUIT
+5 ;
+6 ; unpack data items needed for sorting
+7 ; visit date
SET ACKDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
+8 ; Appointment time
SET ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I")
+9 ; clinic
SET ACKCLN=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"I")
+10 ;
+11 ; file in temp file
+12 SET ^TMP("ACKQPCX",$JOB,"SORT",+ACKVDIV,+ACKCLN,+ACKDT,+ACKTM,+ACKVIEN)=""
+13 ;
+14 ; end of sort
+15 QUIT
PRINT ; print the report for each Division
+1 SET ACKVDIV=""
+2 IF '$DATA(^TMP("ACKQPCX",$JOB,"SORT"))
DO HDR
WRITE !!,"No data found for report specifications.",!!
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
QUIT
+3 FOR
SET ACKVDIV=$ORDER(ACKDIV(ACKVDIV))
if ACKVDIV=""
QUIT
DO PRINT2
if $DATA(DIRUT)
QUIT
+4 QUIT
PRINT2 ; print for a single division
+1 IF '$DATA(^TMP("ACKQPCX",$JOB,"SORT",ACKVDIV))
Begin DoDot:1
+2 DO HDR
WRITE !!,"No data found for report specifications.",!!
+3 if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
End DoDot:1
QUIT
+4 DO HDR
+5 ; walk down the clinics for the Division
+6 SET ACKCLN=""
+7 FOR
SET ACKCLN=$ORDER(^TMP("ACKQPCX",$JOB,"SORT",ACKVDIV,ACKCLN))
if ACKCLN=""
QUIT
Begin DoDot:1
+8 SET ACKDT=""
SET NEWCLN=1
+9 FOR
SET ACKDT=$ORDER(^TMP("ACKQPCX",$JOB,"SORT",ACKVDIV,ACKCLN,ACKDT))
if ACKDT=""
QUIT
Begin DoDot:2
+10 SET ACKTM=""
+11 FOR
SET ACKTM=$ORDER(^TMP("ACKQPCX",$JOB,"SORT",ACKVDIV,ACKCLN,ACKDT,ACKTM))
if ACKTM=""
QUIT
Begin DoDot:3
+12 SET ACKVIEN=""
+13 FOR
SET ACKVIEN=$ORDER(^TMP("ACKQPCX",$JOB,"SORT",ACKVDIV,ACKCLN,ACKDT,ACKTM,ACKVIEN))
if ACKVIEN=""
QUIT
Begin DoDot:4
+14 DO PRINTV
End DoDot:4
if $DATA(DIRUT)
QUIT
End DoDot:3
if $DATA(DIRUT)
QUIT
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+15 if $DATA(DIRUT)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+16 ;
+17 ; end of printing for a division
+18 QUIT
+19 ;
PRINTV ; Print a Visit
+1 KILL ^TMP("ACKQPCX",$JOB,"VISIT")
+2 SET ACKVERR=$NAME(^TMP("ACKQPCX",$JOB,"VISIT"))
+3 DO PCEERR^ACKQUTL3(ACKVIEN,ACKVERR,0,IOM-10)
+4 ;
+5 ; determine whether page throw is required
+6 SET LN=$SELECT(NEWCLN:2,1:0)+3+$SELECT(@ACKVERR:@ACKVERR,1:2)
+7 ; W "($Y=" W $Y,",LN=",LN,")"
+8 IF $Y>(IOSL-LN-2)
SET Y=$Y
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+9 ;
+10 if NEWLN
WRITE !
SET NEWLN=1
+11 ; if new clinic then print clinic name
+12 IF NEWCLN
WRITE !,"Clinic: ",$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E"),!
SET NEWCLN=0
+13 ;
+14 ; get patient data
+15 SET (ACKPAT,DFN)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I")
+16 DO DEM^VADPT
+17 SET ACKPATNM=VADM(1)
SET ACKPATSS=$PIECE(VADM(2),U,2)
+18 ;
+19 ; print visit header
+20 SET Y=ACKDT
DO DD^%DT
SET ACKDTEX=Y
+21 WRITE !,?5,"Visit Date: ",ACKDTEX
+22 WRITE ?40,"Patient: ",$EXTRACT(ACKPATNM,1,40)
+23 WRITE !,?4,"Appnt. Time: ",$$FMT^ACKQUTL6(ACKTM,0)
+24 WRITE ?40," SSN: ",ACKPATSS
+25 ;
+26 ; print errors
+27 IF @ACKVERR
FOR LN=1:1:@ACKVERR
WRITE !,?10,@ACKVERR@(LN)
+28 IF '@ACKVERR
Begin DoDot:1
+29 WRITE !,?10,"Last Edit in QSR: ",$$GET1^DIQ(509850.6,ACKVIEN_",",140,"E")
+30 WRITE !,?10,"Last Sent to PCE: ",$$GET1^DIQ(509850.6,ACKVIEN_",",135,"E")
End DoDot:1
+31 ;
+32 ; end of printing a visit
+33 QUIT
+34 ;
HDR ;
+1 if ($EXTRACT(IOST)="C")!(ACKPG>0)
WRITE @IOF
+2 SET ACKPG=ACKPG+1
+3 WRITE "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
+4 WRITE !
DO CNTR^ACKQUTL("Audiology & Speech Pathology")
+5 WRITE !
DO CNTR^ACKQUTL("PCE Exception Report")
+6 IF ACKVDIV]""
WRITE !
DO CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV)_" "_ACKRDR)
+7 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+8 SET NEWLN=0
+9 QUIT
+10 ;
DIVNAME(ACKVDIV) ; get division name
+1 QUIT $$GET1^DIQ(509850.83,ACKVDIV_",1",.01,"E")
+2 ;
V3DATE(ACKBD) ;
+1 NEW ACKA,ACKB,X,Y,X1,X2,%T,%H,%
+2 SET ACKA=""
+3 SET ACKA=$ORDER(^DIC(9.4,"B","QUASAR",ACKA))
+4 IF ACKA=""
QUIT 1
+5 SET ACKB=""
+6 IF '$DATA(^DIC(9.4,ACKA,22,"B","3.0"))
QUIT 1
+7 SET ACKB=$ORDER(^DIC(9.4,ACKA,22,"B","3.0",ACKB))
+8 IF ACKB=""
QUIT 1
+9 IF '$DATA(^DIC(9.4,ACKA,22,ACKB,0))
QUIT 1
+10 SET Y=$PIECE(^DIC(9.4,ACKA,22,ACKB,0),"^",3)
+11 IF Y=""
QUIT 1
+12 SET Y=$PIECE(Y,".",1)
+13 SET X1=ACKBD
SET X2="1"
DO C^%DTC
SET X=$PIECE(X,".",1)
+14 IF X>Y
QUIT 1
+15 DO DD^%DT
T WRITE !!,"Warning - You are running a report using a start date that falls either on or before the installation of version 3.0 of Quasar."
+1 WRITE !!,"Quasar version 3.0 was installed on - ",Y
+2 WRITE !!,"Note that all PCE related functionality was developed within Quasar version 3.0."
+3 WRITE !,"It is recommended that this report be run using start a date that falls after the installation date.",!
+4 ;
+5 NEW DIR,DUOUT,DTOUT,DIRUT
OK2 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to Continue "
+1 SET DIR("?")="Answer YES to continue running the report or NO to quit."
+2 DO ^DIR
+3 IF Y?1"^"1.E
WRITE !,"Jumping not allowed.",!
GOTO OK2
+4 if $DATA(DIRUT)
SET Y=0
+5 if $DATA(DTOUT)
SET Y=0
+6 QUIT Y
