74 lines
2.7 KiB
Mathematica
74 lines
2.7 KiB
Mathematica
QACSPRD ;HISC/CEW - Spreadsheet reports ;7/17/95 11:04
|
|
;;2.0;Patient Representative;**3,9,12,17**;07/25/1995
|
|
DATE ;
|
|
N QACIFLG,QACXFLG
|
|
S QAQPOP=0
|
|
D DATDIV^QACUTL0 G:QAQPOP EXIT
|
|
BEGIN ;
|
|
K DIR
|
|
S DIR(0)="NA^1:13"
|
|
W !!?5,"1 Contact made by (#C)",!?5,"2 Issue Headers (#I)",!?5,"3 Issues"
|
|
W !?5,"4 Location (#I)"
|
|
W !?5,"5 Service (Old field - Service field de-activated 10/97 - #I)"
|
|
W !?5,"6 Service/Discipline (#I)",!?5,"7 Sex (#I)"
|
|
W !?5,"8 Contact Source (#C)",!?5,"9 Treatment Status (#C)"
|
|
W !?5,"10 Treatment Status (#I)",!?5,"11 Discipline (#I)"
|
|
W !?5,"12 Division (#C)",!?5,"13 Division (#I)",!!
|
|
S DIR("A")="Print Spreadsheet Totals for: "
|
|
S DIR("?")=" Select the number or item you want totalled."
|
|
S DIR("?",1)=" #I means total is by Issues. #C means total is by Contacts."
|
|
S DIR("?",2)=" Enter ""^"" or <RET> to exit."
|
|
D ^DIR K DIR G:$D(DIRUT)!$D(DIROUT) EXIT S QACITEM=Y
|
|
K COUNT,QACPCE,QACLABEL,QACDIV
|
|
N QACRTN
|
|
I QACITEM=1 D CONTACT^QACSPRD1
|
|
I QACITEM=2 D HEAD^QACSPRD3
|
|
I QACITEM=3 D CODE^QACSPRD2
|
|
I QACITEM=4 D LOC^QACSPRD2
|
|
I QACITEM=5 D SERVICE^QACSPRD2
|
|
I QACITEM=6 D SRVDS^QACSPRD3
|
|
I QACITEM=7 D SEX^QACSPRD3
|
|
I QACITEM=8 D SOURCE^QACSPRD1
|
|
I QACITEM=9 D TREATC^QACSPRD1
|
|
I QACITEM=10 D TREATI^QACSPRD1
|
|
I QACITEM=11 D DISC^QACSPRD2
|
|
I QACITEM=12 D DIVC^QACSPRD3
|
|
I QACITEM=13 D DIVI^QACSPRD3
|
|
K DIR S DIR(0)="E" D ^DIR G EXIT:$D(DIRUT),DATE
|
|
EXIT ;
|
|
K DIR,DIROUT,DIRUT,POP,Y
|
|
K QAC1DIV,QACDT,QACITEM,QACNUM,QACPOP,QAQPOP,QACWW
|
|
K ZTDESC,ZTRTN,ZTSAVE
|
|
D K^QAQDATE
|
|
Q
|
|
LOOP1(ROU,NBEG,NEND,QACD0) ;loop through #745.1 within the date range
|
|
S QACDT=NBEG-.0000001 F S QACDT=$O(^QA(745.1,"D",QACDT)) Q:(QACDT'>0)!(QACDT>NEND)!(QACDT\1'?7N) D
|
|
. S QACD0=0 F S QACD0=$O(^QA(745.1,"D",QACDT,QACD0)) Q:QACD0'>0 D
|
|
. . S QACDIV=$P(^QA(745.1,QACD0,0),U,16)
|
|
. . ;S QACWW=""
|
|
. . ;I $G(QACDIV)]"" I $O(^QA(740,1,"QAC2","B",QACDIV,QACWW))']"" S QACDIV=0
|
|
. . I $G(QACDIV)']"" S QACDIV=0
|
|
. . I $O(QACDIV(0))>0 D CHKDIV
|
|
. . I $G(QAC1DIV)]"" I $G(QACDIV)=$G(QAC1DIV) D @ROU
|
|
. . I $G(QAC1DIV)']"" D @ROU
|
|
Q
|
|
ZIS1(ZTRTN,DESC,XFLG) ;subroutine sets up and calls ^%ZIS and ^%ZTLOAD
|
|
K QACXFLG
|
|
K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS I POP S QACPOP=1 Q
|
|
I $D(IO("Q")) D
|
|
. S (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"))=""
|
|
. S (ZTSAVE("QAC1DIV"),ZTSAVE("QACDIV"),ZTSAVE("QAQPOP"))=""
|
|
. S (ZTSAVE("QACTITLE"),ZTSAVE("QACIFLG"))=""
|
|
. I $G(QACIFLG)=1 K ^TMP("QACSPRD2",$J)
|
|
. I $G(QACIFLG)=1 S (ZTSAVE("^TMP(""QACSPRD2"",$J,"),ZTSAVE("QACODE"))=""
|
|
. S ZTDESC="Patient Rep "_DESC_"Spreadsheet Report"
|
|
. D ^%ZTLOAD S QACXFLG=1
|
|
Q
|
|
CHKDIV ;
|
|
N QACD,QACQ
|
|
S QACD=""
|
|
F S QACD=$O(QACDIV(QACD)) Q:QACD']"" D
|
|
. I QACD=QACDIV S QACQ=1
|
|
I $G(QAC1DIV)']"" I $G(QACQ)'=1 S QACDIV=0
|
|
Q
|