Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACKQPCX

ACKQPCX.m

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