ACKQR3 ;AUG/JLTP BIR/PTD HCIOFO/AG - Visits by Diagnosis ;18 Jun 2013 10:20 AM
;;3.0;QUASAR;**8,22,21**;Feb 11, 2000;Build 40
;
; Reference/IA
; $$CSI^ICDEX - 5747
;
OPTN ;Introduce option.
W @IOF,!,"This option produces a report listing clinic visits for a date range"
W !,"sorted by ICD diagnostic codes.",!
;
; get division
S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
; get date range
D DTRANGE^ACKQRU G:$D(DIRUT) EXIT
;change date to internal before calling ICDSYS.
S (DATESPAN,ICD9FLG,ICD10FLG)=0
S INTBEG=$$DATE(ACKXBD)
S INTEND=$$DATE(ACKXED)
; GET VERSION OF DATES
S BEGDT=$$ICDSYS^ACKQAICD(INTBEG)
S ENDDT=$$ICDSYS^ACKQAICD(INTEND)
;SEE IF THERE IS A DATE SPAN
N IMPDATE S IMPDATE=$$IMPDATE^LEXU("10D")
I BEGDT'=ENDDT S DATESPAN=1
I (INTBEG<IMPDATE),(INTEND<IMPDATE) S ICD9FLG=1
I (INTBEG>IMPDATE),(INTEND>IMPDATE) S ICD10FLG=1
S ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
;
; determine the type of report
; returns ACKASB="A","S" or "B"
; ACKSS=1-6 (1=one clinician etc.)
; ACKSTF(x) selected staff members
D PARAMS^ACKQRU G:$D(DIRUT) EXIT
;
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^ACKQR3",ZTDESC="QUASAR - A&SP VISITS BY DIAGNOSIS"
. 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,ACKXBD - beginning of date range (internal,external)
; ACKED,ACKXED - end of date range (internal,external)
; ACKASB - A=audio,S=speech,B=both
; ACKSS - type of report (1=one clinicians etc)
; ACKSTF() - selected clinicians
U IO
D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
K ^TMP("ACKQR3",$J),ACKT,ACKT2 S ACKT=0,ACKT2=0
; walk down the visits using the date index
S ACKD=ACKBD F S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKED) D
. S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D STORE
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
K %,%DT,%I,%ZIS,%T,BEGDT,DATESPAN,DIRUT,DTOUT,DUOUT,ENDDT,I,ICD9FLG,ICD10FLG
K INTBEG,INTEND,JJ,POP,SS,TOT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("ACKQR3",$J)
W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
STORE ;
S ACKHDR=^ACK(509850.6,ACKV,0)
S ACKHDR5=$G(^ACK(509850.6,ACKV,5))
; get Division and make sure it was selected
S ACKVDIV=+$P(ACKHDR5,U,1)
I '$D(ACKDIV(ACKVDIV)) Q
;
S ACKCLNC=+$P(ACKHDR,U,6) ;clinic IEN
S ACK2=$G(^ACK(509850.6,ACKV,2))
S ACKVSC=$P(ACK2,U) ; visit stop code
; determine sort value for visit stop code (will return zero
; if the visit is not to be included in the report)
S ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC) Q:'ACKSORT
; check that the staff member for the visit was selected for this report
I (ACKSS=3)!(ACKSS=6) S ACKLR=$P(ACK2,U,4) ; student
I ACKSS'=3,ACKSS'=6 S ACKLR=$$LEADROLE^ACKQUTL2(ACKV) ; determine lead role
Q:$S(ACKCLNC=0:1,ACKLR="":1,1:0)
Q:'$D(ACKSTF(ACKLR))
; count the Diagnosis codes for the visit
S ACKP=0 F S ACKP=$O(^ACK(509850.6,ACKV,1,ACKP)) Q:'ACKP D
. S ACKICDN=$$GET1^DIQ(509850.63,ACKP_","_ACKV_",",.01,"I","","")
. I '$D(^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",")) D GETDIAG(ACKICDN)
. S X=^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",.01)
. I X="" Q
. ; add to count of Diagnosis codes for staff member
. S ACKCT=+$G(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,X,ACKICD))
. S ^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,X,ACKICD)=ACKCT+1
. ; add to count of Diagnosis codes for the stop code within the division
. S ^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,X,ACKICD)=$G(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,X,ACKICD))+1
. ; add to count of Diagnosis codes totals for all divisions
. S ^TMP("ACKQR3",$J,2,ACKSORT,X,ACKICD)=$G(^TMP("ACKQR3",$J,2,ACKSORT,X,ACKICD))+1
. ; add to the total count for the stop code, division, and the grand total
. S ACKT(ACKVDIV,ACKSORT,ACKICD)=$G(ACKT(ACKVDIV,ACKSORT,ACKICD))+1
. S ACKT(ACKVDIV)=$G(ACKT(ACKVDIV))+1
. S ACKT2(ACKSORT)=$G(ACKT2(ACKSORT))+1,ACKT2=$G(ACKT2)+1
Q
GETDIAG(ACKICDN) ; get Diagnosis data and place in ^TMP
N ACKTMP,ACKMSG,ACKICD9,ACKQDTXT,ACKDN,ACKINFO
S ACKICD=+$$CSI^ICDEX(80,+ACKICDN) ; returns 1 for ICD9 and 30 for ICD10
S ACKINFO=$$ICDDATA^ICDXCODE(ACKICD,+ACKICDN,IMPDATE,"I")
S ACKDN=$P(ACKINFO,U,2)
S ACKTMP=$NA(^TMP("ACKQR3",$J,"ICD9",1))
D GETS^DIQ(80,ACKICDN_",",".01","",ACKTMP,"ACKMSG")
S ACKICD9=^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",.01)
S ACKQDTXT=$$DIAGTXT^ACKQUTL8(ACKICDN,"")
S ^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",3)=ACKQDTXT
S ^TMP("ACKQR3",$J,"ICD9",2,ACKICD9)=ACKICDN
Q
ICDDESC(ACKICD9,ACKICD) ; get the description of an ICD9 from the ^TMP file
N ACKICDN S ACKICDN=^TMP("ACKQR3",$J,"ICD9",2,ACKICD9)
Q ^TMP("ACKQR3",$J,"ICD9",1,80,ACKICDN_",",3)
PRINT ; print the report for each Division
S ACKVDIV=""
I '$D(^TMP("ACKQR3",$J,1)) D Q
. D HDR
. W !!,"No data found for report specifications.",!!
. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV="" D PRINT2 Q:$D(DIRUT)
I '$D(DIRUT) D TOTALS
Q
PRINT2 ; print for a single division
I '$D(^TMP("ACKQR3",$J,1,ACKVDIV)) D Q
. D HDR W !!,"No data found for report specifications.",!!
. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
D HDR
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
.I $Y>(IOSL-9) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
.W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
.S ACKCLN=""
.F S ACKCLN=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN)) Q:ACKCLN=""!($D(DIRUT)) D
..I $Y>(IOSL-7) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
..W !!,"CLINIC: ",$$GET1^DIQ(44,ACKCLN_",",.01)
..S ACKSTF=""
..F S ACKSTF=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF)) Q:ACKSTF=""!($D(DIRUT)) D
...I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
...W !!,$S("1^4"[ACKSS:"CLINICIAN: ","2^5"[ACKSS:"OTHER PROVIDER: ",1:"STUDENT: ")
...W $$CONVERT^ACKQUTL4(ACKSTF)
...S ACKPC=""
...F S ACKPC=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC)) Q:ACKPC=""!($D(DIRUT)) D
....S ACKICD=""
....F S ACKICD=$O(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD)) Q:ACKICD="" D
.....I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
.....I ACKICD=1 D Q
......S ICD9ARY(ACKPC,ACKICD)=""
.....I ACKICD=30 D Q
......S ICD10ARY(ACKPC,ACKICD)=""
...I DATESPAN D PRTDTSPN ;DATESPAN
...I 'DATESPAN&ICD9FLG D ICD9PRT ;ICD9 DATA ONLY
...I 'DATESPAN&ICD10FLG D ICD10PRT ;ICD10 DATA ONLY
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
SUMM ;
Q:'$D(^TMP("ACKQR3",$J,0)) D SUMHD
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
.I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
.W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
.S ACKPC=""
.F S ACKPC=$O(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,ACKPC)) Q:ACKPC=""!($D(DIRUT)) D
..S ACKICD=""
..F S ACKICD=$O(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,ACKPC,ACKICD)) Q:ACKICD="" D
...I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
...K ACKICDDS,ACKARNUM S ACKICDDS=$$ICDDESC(ACKPC) D BRKDESC(57)
...;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
...W !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
...W $J(^TMP("ACKQR3",$J,0,ACKVDIV,ACKSORT,ACKPC,ACKICD),4)
...F ACKARNM2=2:1:ACKARNUM W !?9,ACKICDDS(ACKARNM2)
...K ACKICDDS,ACKARNUM,ACKARNM2
.I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
.Q:$D(DIRUT)
.W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
.S ACKICD=$S(ICD9FLG=1:1,ICD10FLG=1:30,1:"")
.I ACKICD="",DATESPAN=1 D
..S TOT=0,ACKICD="" F S ACKICD=$O(ACKT(ACKVDIV,ACKSORT,ACKICD)) Q:ACKICD="" D
...S TOT=TOT+$G(ACKT(ACKVDIV,ACKSORT,ACKICD))
..W ?76,$J(TOT,4)
.I (ICD9FLG)!(ICD10FLG) W ?76,$J(ACKT(ACKVDIV,ACKSORT,ACKICD),4)
I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
Q:$D(DIRUT) W !!,"Total For Division: "_$$DIVNAME(ACKVDIV),?76,$J(ACKT(ACKVDIV),4)
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
Q
TOTALS ; print the final page of totals for all divisions
Q:'$D(^TMP("ACKQR3",$J,2))
I $O(ACKT(""))=$O(ACKT(""),-1) Q ; there must be only one division!
D TOTLHD S ACKTXT="DIVISIONS: "
S ACKVDIV="" F S ACKVDIV=$O(ACKT(ACKVDIV)) Q:ACKVDIV="" D Q:$D(DIRUT)
. I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. W !,ACKTXT,?12,$$DIVNAME(ACKVDIV) S ACKTXT=""
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR3",$J,2,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
.I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
.W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
.S ACKPC=""
.F S ACKPC=$O(^TMP("ACKQR3",$J,2,ACKSORT,ACKPC)) Q:ACKPC=""!($D(DIRUT)) D
..S ACKICD=""
..F S ACKICD=$O(^TMP("ACKQR3",$J,2,ACKSORT,ACKPC,ACKICD)) Q:ACKICD="" D
...I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
...K ACKICDDS,ACKARNUM S ACKICDDS=$$ICDDESC(ACKPC) D BRKDESC(57)
...;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
...W !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
...W $J(^TMP("ACKQR3",$J,2,ACKSORT,ACKPC,ACKICD),4)
...F ACKARNM2=2:1:ACKARNUM W !?9,ACKICDDS(ACKARNM2)
...K ACKICDDS,ACKARNUM,ACKARNM2
.I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
.Q:$D(DIRUT)
.W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
.W ?76,$J(ACKT2(ACKSORT),4)
I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
Q:$D(DIRUT) W !!,"Grand Total:",?76,$J(ACKT2,4)
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
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("Diagnostic Code Statistics")
W ! D CNTR^ACKQUTL("for")
I ACKSS<4 S X=$$STAFFNM($O(ACKSTF(0))) W ! D CNTR^ACKQUTL(X)
I ACKSS=4 W ! D CNTR^ACKQUTL("All Clinicians")
I ACKSS=5 W ! D CNTR^ACKQUTL("All Other Providers")
I ACKSS=6 W ! D CNTR^ACKQUTL("All Students")
W ! D CNTR^ACKQUTL("Covering "_ACKRDR)
I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
S X="",$P(X,"-",IOM)="-" W !,X
Q
SUMHD ;
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("Diagnostic Code Statistics")
W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
W ! D CNTR^ACKQUTL("Summary")
S X="",$P(X,"-",IOM)="-" W !,X
Q
TOTLHD ;
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("Diagnostic Code Statistics")
W ! D CNTR^ACKQUTL("Summary")
S X="",$P(X,"-",IOM)="-" W !,X
Q
;
DIVNAME(ACKVDIV) ; get division name
Q $$GET1^DIQ(40.8,ACKVDIV_",",.01)
;
STAFFNM(ACKSTF) ; get staff name
Q $$MIXC^ACKQUTL($$CONVERT^ACKQUTL4(ACKSTF))
;
DATE(EDTE) ; -- Converts external date to internal date format
; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
; (TIME WILL BE RETURNED IF INCLUDED WITH INPUT)
;
Q:'$D(EDTE) -1
N X,%DT,Y
S X=EDTE
S %DT="TS"
D ^%DT
Q Y
PRTDTSPN ;Print desginated code sorted by ICD9 or ICD10
N ACKCNT
W !,"ICD-9 DIAGNOSIS"
S ACKPC=""
F S ACKPC=$O(ICD9ARY(ACKPC)) Q:ACKPC="" D
.S ACKICD=""
.F S ACKICD=$O(ICD9ARY(ACKPC,ACKICD)) Q:ACKICD="" D
..S ACKCNT=+$G(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD))
..Q:ACKCNT<1
..K ACKICDDS,ACKARNUM S ACKICDDS=$$ICDDESC(ACKPC) D BRKDESC(57)
..;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
..W !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
..W $J(ACKCNT,4)
..F ACKARNM2=2:1:ACKARNUM W !?9,ACKICDDS(ACKARNM2)
..K ACKICDDS,ACKARNUM,ACKARNM2
W !,"ICD-10 DIAGNOSIS"
S ACKPC=""
F S ACKPC=$O(ICD10ARY(ACKPC)) Q:ACKPC="" D
.S ACKICD=""
.F S ACKICD=$O(ICD10ARY(ACKPC,ACKICD)) Q:ACKICD="" D
..S ACKCNT=+$G(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD))
..Q:ACKCNT<1
..K ACKICDDS,ACKARNUM S ACKICDDS=$$ICDDESC(ACKPC) D BRKDESC(57)
..;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
..W !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
..W $J(ACKCNT,4)
..F ACKARNM2=2:1:ACKARNUM W !?9,ACKICDDS(ACKARNM2)
..K ACKICDDS,ACKARNUM,ACKARNM2
Q
ICD9PRT ;Print ICD9 codes
F S ACKPC=$O(ICD9ARY(ACKPC)) Q:ACKPC="" D
.S ACKICD=""
.F S ACKICD=$O(ICD9ARY(ACKPC,ACKICD)) Q:ACKICD="" D
..K ACKICDDS,ACKARNUM S ACKICDDS=$$ICDDESC(ACKPC) D BRKDESC(57)
..;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
..W !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
..W $J($G(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD)),4)
..F ACKARNM2=2:1:ACKARNUM W !?9,ACKICDDS(ACKARNM2)
..K ACKICDDS,ACKARNUM,ACKARNM2
K ICD9ARY
Q
ICD10PRT ;Print ICD10 codes
S ACKPC=""
F S ACKPC=$O(ICD10ARY(ACKPC)) Q:ACKPC="" D
.S ACKICD=""
.F S ACKICD=$O(ICD10ARY(ACKPC,ACKICD)) Q:ACKICD="" D
..K ACKICDDS,ACKARNUM S ACKICDDS=$$ICDDESC(ACKPC) D BRKDESC(57)
..;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
..W !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
..W $J($G(^TMP("ACKQR3",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD)),4)
..F ACKARNM2=2:1:ACKARNUM W !?9,ACKICDDS(ACKARNM2)
..K ACKICDDS,ACKARNUM,ACKARNM2
K ICD10ARY
Q
;
BRKDESC(ACKWIDTH) ; If ICD Description too long break it into multiple lines
I ACKICDDS="" S ACKICDDS(1)="" Q ; should not happen
S ACKICDDS=$$UP^XLFSTR(ACKICDDS)
S ACKARNUM=1,ACKICDDS(ACKARNUM)=""
F ACKWRDNM=1:1:$L(ACKICDDS," ") D
. S ACKWORD=$P(ACKICDDS," ",ACKWRDNM) Q:ACKWORD=""
. I $L(ACKICDDS(ACKARNUM))+$L(ACKWORD)+1>ACKWIDTH D Q
.. S ACKARNUM=ACKARNUM+1,ACKICDDS(ACKARNUM)=ACKWORD_" "
. S ACKICDDS(ACKARNUM)=ACKICDDS(ACKARNUM)_ACKWORD_" "
K ACKWRDNM,ACKWORD Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQR3 14543 printed Apr 09, 2024@21:35:31 Page 2
ACKQR3 ;AUG/JLTP BIR/PTD HCIOFO/AG - Visits by Diagnosis ;18 Jun 2013 10:20 AM
+1 ;;3.0;QUASAR;**8,22,21**;Feb 11, 2000;Build 40
+2 ;
+3 ; Reference/IA
+4 ; $$CSI^ICDEX - 5747
+5 ;
OPTN ;Introduce option.
+1 WRITE @IOF,!,"This option produces a report listing clinic visits for a date range"
+2 WRITE !,"sorted by ICD diagnostic codes.",!
+3 ;
+4 ; get division
+5 SET ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI")
if +ACKDIV=0
GOTO EXIT
+6 ; get date range
+7 DO DTRANGE^ACKQRU
if $DATA(DIRUT)
GOTO EXIT
+8 ;change date to internal before calling ICDSYS.
+9 SET (DATESPAN,ICD9FLG,ICD10FLG)=0
+10 SET INTBEG=$$DATE(ACKXBD)
+11 SET INTEND=$$DATE(ACKXED)
+12 ; GET VERSION OF DATES
+13 SET BEGDT=$$ICDSYS^ACKQAICD(INTBEG)
+14 SET ENDDT=$$ICDSYS^ACKQAICD(INTEND)
+15 ;SEE IF THERE IS A DATE SPAN
+16 NEW IMPDATE
SET IMPDATE=$$IMPDATE^LEXU("10D")
+17 IF BEGDT'=ENDDT
SET DATESPAN=1
+18 IF (INTBEG<IMPDATE)
IF (INTEND<IMPDATE)
SET ICD9FLG=1
+19 IF (INTBEG>IMPDATE)
IF (INTEND>IMPDATE)
SET ICD10FLG=1
+20 SET ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
+21 ;
+22 ; determine the type of report
+23 ; returns ACKASB="A","S" or "B"
+24 ; ACKSS=1-6 (1=one clinician etc.)
+25 ; ACKSTF(x) selected staff members
+26 DO PARAMS^ACKQRU
if $DATA(DIRUT)
GOTO EXIT
+27 ;
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^ACKQR3"
SET ZTDESC="QUASAR - A&SP VISITS BY DIAGNOSIS"
+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,ACKXBD - beginning of date range (internal,external)
+4 ; ACKED,ACKXED - end of date range (internal,external)
+5 ; ACKASB - A=audio,S=speech,B=both
+6 ; ACKSS - type of report (1=one clinicians etc)
+7 ; ACKSTF() - selected clinicians
+8 USE IO
+9 DO NOW^%DTC
SET ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
SET ACKPG=0
+10 KILL ^TMP("ACKQR3",$JOB),ACKT,ACKT2
SET ACKT=0
SET ACKT2=0
+11 ; walk down the visits using the date index
+12 SET ACKD=ACKBD
FOR
SET ACKD=$ORDER(^ACK(509850.6,"B",ACKD))
if 'ACKD!(ACKD>ACKED)
QUIT
Begin DoDot:1
+13 SET ACKV=0
FOR
SET ACKV=$ORDER(^ACK(509850.6,"B",ACKD,ACKV))
if 'ACKV
QUIT
DO STORE
End DoDot:1
+14 DO PRINT
+15 ;
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
+6 KILL %,%DT,%I,%ZIS,%T,BEGDT,DATESPAN,DIRUT,DTOUT,DUOUT,ENDDT,I,ICD9FLG,ICD10FLG
+7 KILL INTBEG,INTEND,JJ,POP,SS,TOT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("ACKQR3",$JOB)
+8 if $EXTRACT(IOST)="C"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+9 QUIT
STORE ;
+1 SET ACKHDR=^ACK(509850.6,ACKV,0)
+2 SET ACKHDR5=$GET(^ACK(509850.6,ACKV,5))
+3 ; get Division and make sure it was selected
+4 SET ACKVDIV=+$PIECE(ACKHDR5,U,1)
+5 IF '$DATA(ACKDIV(ACKVDIV))
QUIT
+6 ;
+7 ;clinic IEN
SET ACKCLNC=+$PIECE(ACKHDR,U,6)
+8 SET ACK2=$GET(^ACK(509850.6,ACKV,2))
+9 ; visit stop code
SET ACKVSC=$PIECE(ACK2,U)
+10 ; determine sort value for visit stop code (will return zero
+11 ; if the visit is not to be included in the report)
+12 SET ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC)
if 'ACKSORT
QUIT
+13 ; check that the staff member for the visit was selected for this report
+14 ; student
IF (ACKSS=3)!(ACKSS=6)
SET ACKLR=$PIECE(ACK2,U,4)
+15 ; determine lead role
IF ACKSS'=3
IF ACKSS'=6
SET ACKLR=$$LEADROLE^ACKQUTL2(ACKV)
+16 if $SELECT(ACKCLNC=0
QUIT
+17 if '$DATA(ACKSTF(ACKLR))
QUIT
+18 ; count the Diagnosis codes for the visit
+19 SET ACKP=0
FOR
SET ACKP=$ORDER(^ACK(509850.6,ACKV,1,ACKP))
if 'ACKP
QUIT
Begin DoDot:1
+20 SET ACKICDN=$$GET1^DIQ(509850.63,ACKP_","_ACKV_",",.01,"I","","")
+21 IF '$DATA(^TMP("ACKQR3",$JOB,"ICD9",1,80,ACKICDN_","))
DO GETDIAG(ACKICDN)
+22 SET X=^TMP("ACKQR3",$JOB,"ICD9",1,80,ACKICDN_",",.01)
+23 IF X=""
QUIT
+24 ; add to count of Diagnosis codes for staff member
+25 SET ACKCT=+$GET(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,X,ACKICD))
+26 SET ^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,X,ACKICD)=ACKCT+1
+27 ; add to count of Diagnosis codes for the stop code within the division
+28 SET ^TMP("ACKQR3",$JOB,0,ACKVDIV,ACKSORT,X,ACKICD)=$GET(^TMP("ACKQR3",$JOB,0,ACKVDIV,ACKSORT,X,ACKICD))+1
+29 ; add to count of Diagnosis codes totals for all divisions
+30 SET ^TMP("ACKQR3",$JOB,2,ACKSORT,X,ACKICD)=$GET(^TMP("ACKQR3",$JOB,2,ACKSORT,X,ACKICD))+1
+31 ; add to the total count for the stop code, division, and the grand total
+32 SET ACKT(ACKVDIV,ACKSORT,ACKICD)=$GET(ACKT(ACKVDIV,ACKSORT,ACKICD))+1
+33 SET ACKT(ACKVDIV)=$GET(ACKT(ACKVDIV))+1
+34 SET ACKT2(ACKSORT)=$GET(ACKT2(ACKSORT))+1
SET ACKT2=$GET(ACKT2)+1
End DoDot:1
+35 QUIT
GETDIAG(ACKICDN) ; get Diagnosis data and place in ^TMP
+1 NEW ACKTMP,ACKMSG,ACKICD9,ACKQDTXT,ACKDN,ACKINFO
+2 ; returns 1 for ICD9 and 30 for ICD10
SET ACKICD=+$$CSI^ICDEX(80,+ACKICDN)
+3 SET ACKINFO=$$ICDDATA^ICDXCODE(ACKICD,+ACKICDN,IMPDATE,"I")
+4 SET ACKDN=$PIECE(ACKINFO,U,2)
+5 SET ACKTMP=$NAME(^TMP("ACKQR3",$JOB,"ICD9",1))
+6 DO GETS^DIQ(80,ACKICDN_",",".01","",ACKTMP,"ACKMSG")
+7 SET ACKICD9=^TMP("ACKQR3",$JOB,"ICD9",1,80,ACKICDN_",",.01)
+8 SET ACKQDTXT=$$DIAGTXT^ACKQUTL8(ACKICDN,"")
+9 SET ^TMP("ACKQR3",$JOB,"ICD9",1,80,ACKICDN_",",3)=ACKQDTXT
+10 SET ^TMP("ACKQR3",$JOB,"ICD9",2,ACKICD9)=ACKICDN
+11 QUIT
ICDDESC(ACKICD9,ACKICD) ; get the description of an ICD9 from the ^TMP file
+1 NEW ACKICDN
SET ACKICDN=^TMP("ACKQR3",$JOB,"ICD9",2,ACKICD9)
+2 QUIT ^TMP("ACKQR3",$JOB,"ICD9",1,80,ACKICDN_",",3)
PRINT ; print the report for each Division
+1 SET ACKVDIV=""
+2 IF '$DATA(^TMP("ACKQR3",$JOB,1))
Begin DoDot:1
+3 DO HDR
+4 WRITE !!,"No data found for report specifications.",!!
+5 if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
End DoDot:1
QUIT
+6 FOR
SET ACKVDIV=$ORDER(ACKDIV(ACKVDIV))
if ACKVDIV=""
QUIT
DO PRINT2
if $DATA(DIRUT)
QUIT
+7 IF '$DATA(DIRUT)
DO TOTALS
+8 QUIT
PRINT2 ; print for a single division
+1 IF '$DATA(^TMP("ACKQR3",$JOB,1,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 SET ACKSORT=""
+6 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT))
if ACKSORT=""!($DATA(DIRUT))
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-9)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+8 WRITE !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
+9 SET ACKCLN=""
+10 FOR
SET ACKCLN=$ORDER(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN))
if ACKCLN=""!($DATA(DIRUT))
QUIT
Begin DoDot:2
+11 IF $Y>(IOSL-7)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+12 WRITE !!,"CLINIC: ",$$GET1^DIQ(44,ACKCLN_",",.01)
+13 SET ACKSTF=""
+14 FOR
SET ACKSTF=$ORDER(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF))
if ACKSTF=""!($DATA(DIRUT))
QUIT
Begin DoDot:3
+15 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+16 WRITE !!,$SELECT("1^4"[ACKSS:"CLINICIAN: ","2^5"[ACKSS:"OTHER PROVIDER: ",1:"STUDENT: ")
+17 WRITE $$CONVERT^ACKQUTL4(ACKSTF)
+18 SET ACKPC=""
+19 FOR
SET ACKPC=$ORDER(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC))
if ACKPC=""!($DATA(DIRUT))
QUIT
Begin DoDot:4
+20 SET ACKICD=""
+21 FOR
SET ACKICD=$ORDER(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:5
+22 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+23 IF ACKICD=1
Begin DoDot:6
+24 SET ICD9ARY(ACKPC,ACKICD)=""
End DoDot:6
QUIT
+25 IF ACKICD=30
Begin DoDot:6
+26 SET ICD10ARY(ACKPC,ACKICD)=""
End DoDot:6
QUIT
End DoDot:5
End DoDot:4
+27 ;DATESPAN
IF DATESPAN
DO PRTDTSPN
+28 ;ICD9 DATA ONLY
IF 'DATESPAN&ICD9FLG
DO ICD9PRT
+29 ;ICD10 DATA ONLY
IF 'DATESPAN&ICD10FLG
DO ICD10PRT
End DoDot:3
End DoDot:2
End DoDot:1
+30 if $DATA(DIRUT)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
SUMM ;
+1 if '$DATA(^TMP("ACKQR3",$JOB,0))
QUIT
DO SUMHD
+2 SET ACKSORT=""
+3 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR3",$JOB,0,ACKVDIV,ACKSORT))
if ACKSORT=""!($DATA(DIRUT))
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+5 WRITE !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
+6 SET ACKPC=""
+7 FOR
SET ACKPC=$ORDER(^TMP("ACKQR3",$JOB,0,ACKVDIV,ACKSORT,ACKPC))
if ACKPC=""!($DATA(DIRUT))
QUIT
Begin DoDot:2
+8 SET ACKICD=""
+9 FOR
SET ACKICD=$ORDER(^TMP("ACKQR3",$JOB,0,ACKVDIV,ACKSORT,ACKPC,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:3
+10 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+11 KILL ACKICDDS,ACKARNUM
SET ACKICDDS=$$ICDDESC(ACKPC)
DO BRKDESC(57)
+12 ;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
+13 WRITE !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
+14 WRITE $JUSTIFY(^TMP("ACKQR3",$JOB,0,ACKVDIV,ACKSORT,ACKPC,ACKICD),4)
+15 FOR ACKARNM2=2:1:ACKARNUM
WRITE !?9,ACKICDDS(ACKARNM2)
+16 KILL ACKICDDS,ACKARNUM,ACKARNM2
End DoDot:3
End DoDot:2
+17 IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+18 if $DATA(DIRUT)
QUIT
+19 WRITE !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
+20 SET ACKICD=$SELECT(ICD9FLG=1:1,ICD10FLG=1:30,1:"")
+21 IF ACKICD=""
IF DATESPAN=1
Begin DoDot:2
+22 SET TOT=0
SET ACKICD=""
FOR
SET ACKICD=$ORDER(ACKT(ACKVDIV,ACKSORT,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:3
+23 SET TOT=TOT+$GET(ACKT(ACKVDIV,ACKSORT,ACKICD))
End DoDot:3
+24 WRITE ?76,$JUSTIFY(TOT,4)
End DoDot:2
+25 IF (ICD9FLG)!(ICD10FLG)
WRITE ?76,$JUSTIFY(ACKT(ACKVDIV,ACKSORT,ACKICD),4)
End DoDot:1
+26 IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+27 if $DATA(DIRUT)
QUIT
WRITE !!,"Total For Division: "_$$DIVNAME(ACKVDIV),?76,$JUSTIFY(ACKT(ACKVDIV),4)
+28 if $DATA(DIRUT)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+29 QUIT
TOTALS ; print the final page of totals for all divisions
+1 if '$DATA(^TMP("ACKQR3",$JOB,2))
QUIT
+2 ; there must be only one division!
IF $ORDER(ACKT(""))=$ORDER(ACKT(""),-1)
QUIT
+3 DO TOTLHD
SET ACKTXT="DIVISIONS: "
+4 SET ACKVDIV=""
FOR
SET ACKVDIV=$ORDER(ACKT(ACKVDIV))
if ACKVDIV=""
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+6 WRITE !,ACKTXT,?12,$$DIVNAME(ACKVDIV)
SET ACKTXT=""
End DoDot:1
if $DATA(DIRUT)
QUIT
+7 SET ACKSORT=""
+8 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR3",$JOB,2,ACKSORT))
if ACKSORT=""!($DATA(DIRUT))
QUIT
Begin DoDot:1
+9 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+10 WRITE !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
+11 SET ACKPC=""
+12 FOR
SET ACKPC=$ORDER(^TMP("ACKQR3",$JOB,2,ACKSORT,ACKPC))
if ACKPC=""!($DATA(DIRUT))
QUIT
Begin DoDot:2
+13 SET ACKICD=""
+14 FOR
SET ACKICD=$ORDER(^TMP("ACKQR3",$JOB,2,ACKSORT,ACKPC,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:3
+15 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+16 KILL ACKICDDS,ACKARNUM
SET ACKICDDS=$$ICDDESC(ACKPC)
DO BRKDESC(57)
+17 ;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
+18 WRITE !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
+19 WRITE $JUSTIFY(^TMP("ACKQR3",$JOB,2,ACKSORT,ACKPC,ACKICD),4)
+20 FOR ACKARNM2=2:1:ACKARNUM
WRITE !?9,ACKICDDS(ACKARNM2)
+21 KILL ACKICDDS,ACKARNUM,ACKARNM2
End DoDot:3
End DoDot:2
+22 IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+23 if $DATA(DIRUT)
QUIT
+24 WRITE !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
+25 WRITE ?76,$JUSTIFY(ACKT2(ACKSORT),4)
End DoDot:1
+26 IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+27 if $DATA(DIRUT)
QUIT
WRITE !!,"Grand Total:",?76,$JUSTIFY(ACKT2,4)
+28 if $DATA(DIRUT)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+29 QUIT
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("Diagnostic Code Statistics")
+6 WRITE !
DO CNTR^ACKQUTL("for")
+7 IF ACKSS<4
SET X=$$STAFFNM($ORDER(ACKSTF(0)))
WRITE !
DO CNTR^ACKQUTL(X)
+8 IF ACKSS=4
WRITE !
DO CNTR^ACKQUTL("All Clinicians")
+9 IF ACKSS=5
WRITE !
DO CNTR^ACKQUTL("All Other Providers")
+10 IF ACKSS=6
WRITE !
DO CNTR^ACKQUTL("All Students")
+11 WRITE !
DO CNTR^ACKQUTL("Covering "_ACKRDR)
+12 IF ACKVDIV]""
WRITE !
DO CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
+13 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+14 QUIT
SUMHD ;
+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("Diagnostic Code Statistics")
+6 WRITE !
DO CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
+7 WRITE !
DO CNTR^ACKQUTL("Summary")
+8 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+9 QUIT
TOTLHD ;
+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("Diagnostic Code Statistics")
+6 WRITE !
DO CNTR^ACKQUTL("Summary")
+7 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+8 QUIT
+9 ;
DIVNAME(ACKVDIV) ; get division name
+1 QUIT $$GET1^DIQ(40.8,ACKVDIV_",",.01)
+2 ;
STAFFNM(ACKSTF) ; get staff name
+1 QUIT $$MIXC^ACKQUTL($$CONVERT^ACKQUTL4(ACKSTF))
+2 ;
DATE(EDTE) ; -- Converts external date to internal date format
+1 ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
+2 ; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
+3 ; (TIME WILL BE RETURNED IF INCLUDED WITH INPUT)
+4 ;
+5 if '$DATA(EDTE)
QUIT -1
+6 NEW X,%DT,Y
+7 SET X=EDTE
+8 SET %DT="TS"
+9 DO ^%DT
+10 QUIT Y
PRTDTSPN ;Print desginated code sorted by ICD9 or ICD10
+1 NEW ACKCNT
+2 WRITE !,"ICD-9 DIAGNOSIS"
+3 SET ACKPC=""
+4 FOR
SET ACKPC=$ORDER(ICD9ARY(ACKPC))
if ACKPC=""
QUIT
Begin DoDot:1
+5 SET ACKICD=""
+6 FOR
SET ACKICD=$ORDER(ICD9ARY(ACKPC,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:2
+7 SET ACKCNT=+$GET(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD))
+8 if ACKCNT<1
QUIT
+9 KILL ACKICDDS,ACKARNUM
SET ACKICDDS=$$ICDDESC(ACKPC)
DO BRKDESC(57)
+10 ;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
+11 WRITE !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
+12 WRITE $JUSTIFY(ACKCNT,4)
+13 FOR ACKARNM2=2:1:ACKARNUM
WRITE !?9,ACKICDDS(ACKARNM2)
+14 KILL ACKICDDS,ACKARNUM,ACKARNM2
End DoDot:2
End DoDot:1
+15 WRITE !,"ICD-10 DIAGNOSIS"
+16 SET ACKPC=""
+17 FOR
SET ACKPC=$ORDER(ICD10ARY(ACKPC))
if ACKPC=""
QUIT
Begin DoDot:1
+18 SET ACKICD=""
+19 FOR
SET ACKICD=$ORDER(ICD10ARY(ACKPC,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:2
+20 SET ACKCNT=+$GET(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD))
+21 if ACKCNT<1
QUIT
+22 KILL ACKICDDS,ACKARNUM
SET ACKICDDS=$$ICDDESC(ACKPC)
DO BRKDESC(57)
+23 ;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
+24 WRITE !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
+25 WRITE $JUSTIFY(ACKCNT,4)
+26 FOR ACKARNM2=2:1:ACKARNUM
WRITE !?9,ACKICDDS(ACKARNM2)
+27 KILL ACKICDDS,ACKARNUM,ACKARNM2
End DoDot:2
End DoDot:1
+28 QUIT
ICD9PRT ;Print ICD9 codes
+1 FOR
SET ACKPC=$ORDER(ICD9ARY(ACKPC))
if ACKPC=""
QUIT
Begin DoDot:1
+2 SET ACKICD=""
+3 FOR
SET ACKICD=$ORDER(ICD9ARY(ACKPC,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:2
+4 KILL ACKICDDS,ACKARNUM
SET ACKICDDS=$$ICDDESC(ACKPC)
DO BRKDESC(57)
+5 ;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
+6 WRITE !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
+7 WRITE $JUSTIFY($GET(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD)),4)
+8 FOR ACKARNM2=2:1:ACKARNUM
WRITE !?9,ACKICDDS(ACKARNM2)
+9 KILL ACKICDDS,ACKARNUM,ACKARNM2
End DoDot:2
End DoDot:1
+10 KILL ICD9ARY
+11 QUIT
ICD10PRT ;Print ICD10 codes
+1 SET ACKPC=""
+2 FOR
SET ACKPC=$ORDER(ICD10ARY(ACKPC))
if ACKPC=""
QUIT
Begin DoDot:1
+3 SET ACKICD=""
+4 FOR
SET ACKICD=$ORDER(ICD10ARY(ACKPC,ACKICD))
if ACKICD=""
QUIT
Begin DoDot:2
+5 KILL ACKICDDS,ACKARNUM
SET ACKICDDS=$$ICDDESC(ACKPC)
DO BRKDESC(57)
+6 ;W !,ACKPC,?9,$$ICDDESC(ACKPC),?69,"COUNT: "
+7 WRITE !,ACKPC,?9,ACKICDDS(1),?69,"COUNT: "
+8 WRITE $JUSTIFY($GET(^TMP("ACKQR3",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKPC,ACKICD)),4)
+9 FOR ACKARNM2=2:1:ACKARNUM
WRITE !?9,ACKICDDS(ACKARNM2)
+10 KILL ACKICDDS,ACKARNUM,ACKARNM2
End DoDot:2
End DoDot:1
+11 KILL ICD10ARY
+12 QUIT
+13 ;
BRKDESC(ACKWIDTH) ; If ICD Description too long break it into multiple lines
+1 ; should not happen
IF ACKICDDS=""
SET ACKICDDS(1)=""
QUIT
+2 SET ACKICDDS=$$UP^XLFSTR(ACKICDDS)
+3 SET ACKARNUM=1
SET ACKICDDS(ACKARNUM)=""
+4 FOR ACKWRDNM=1:1:$LENGTH(ACKICDDS," ")
Begin DoDot:1
+5 SET ACKWORD=$PIECE(ACKICDDS," ",ACKWRDNM)
if ACKWORD=""
QUIT
+6 IF $LENGTH(ACKICDDS(ACKARNUM))+$LENGTH(ACKWORD)+1>ACKWIDTH
Begin DoDot:2
+7 SET ACKARNUM=ACKARNUM+1
SET ACKICDDS(ACKARNUM)=ACKWORD_" "
End DoDot:2
QUIT
+8 SET ACKICDDS(ACKARNUM)=ACKICDDS(ACKARNUM)_ACKWORD_" "
End DoDot:1
+9 KILL ACKWRDNM,ACKWORD
QUIT
+10 ;
