| 1 | QACUTL0 ;WCIOFO/ERC/VAD - Utility for Patient Rep reports ;29 Dec 98
|
|---|
| 2 | ;;2.0;Patient Representative;**10,9,17**;07/25/1995
|
|---|
| 3 | ;
|
|---|
| 4 | DATDIV ;
|
|---|
| 5 | D DATE Q:QAQPOP
|
|---|
| 6 | D DIV Q:QAQPOP
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | DATE ;select date range for Patient Rep
|
|---|
| 10 | S QAQPOP=0
|
|---|
| 11 | W !!,"Select the date range you want to print."
|
|---|
| 12 | D ^QAQDATE I QAQQUIT S QAQPOP=1 Q
|
|---|
| 13 | I QAQNBEG>DT W !,"*** Beginning date must be today or earlier! ***",$C(7) G DATE
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | DIV ;select Patient Rep division
|
|---|
| 17 | K QAC1DIV,QACDV,QACDVSN
|
|---|
| 18 | S QAQPOP=0
|
|---|
| 19 | S QACDV=1 ;with patch 17 division always enabled
|
|---|
| 20 | ;
|
|---|
| 21 | N DIR,DIRUT,DTOUT,DUOUT
|
|---|
| 22 | S DIR(0)="YA"
|
|---|
| 23 | S DIR("A")="Select ALL Divisions? "
|
|---|
| 24 | S DIR("B")="YES"
|
|---|
| 25 | D ^DIR K DIR I $D(DIRUT) S QAQPOP=1 Q
|
|---|
| 26 | I Y S QAC1DIV="" Q
|
|---|
| 27 | N DIC,QACX
|
|---|
| 28 | S DIC="^DIC(4,"
|
|---|
| 29 | S DIC(0)="AEMZQ"
|
|---|
| 30 | S DIC("A")="Enter Division: "
|
|---|
| 31 | S DIC("S")="I $D(^DG(40.8,""AD"",+Y))"
|
|---|
| 32 | S QACX=$$SITE^VASITE
|
|---|
| 33 | S QACDVSN=$P(QACX,U,2)
|
|---|
| 34 | S DIC("B")=$G(QACDVSN)
|
|---|
| 35 | D ^DIC K DIC
|
|---|
| 36 | I +Y>0 S QAC1DIV=+Y Q
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | TASK ;set variables for call to ^%ZTLOAD
|
|---|
| 40 | S (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"))=""
|
|---|
| 41 | S ZTSAVE("QAQ2HED")=""
|
|---|
| 42 | S (ZTSAVE("QACDIV"),ZTSAVE("QAC1DIV"))=""
|
|---|
| 43 | S (ZTSAVE("QACTEXT"),ZTSAVE("QACDESC"))=""
|
|---|
| 44 | D ^%ZTLOAD
|
|---|
| 45 | I $G(ZTSK) W !,"Task Number: ",ZTSK
|
|---|
| 46 | Q
|
|---|
| 47 | INST(QACIEN,QACDV) ;uses FileMan for name of a division from the Institution file (#4)
|
|---|
| 48 | N DIC,X,Y
|
|---|
| 49 | K QACDV
|
|---|
| 50 | S DIC="^DIC(4,"
|
|---|
| 51 | S DIC(0)="NZX"
|
|---|
| 52 | S X=QACIEN
|
|---|
| 53 | D ^DIC K DIC
|
|---|
| 54 | I Y<0 S QACDV="Unknown" Q
|
|---|
| 55 | S QACDV=Y(0,0)
|
|---|
| 56 | Q
|
|---|
| 57 | SITE(QACIEN,QACSIT) ;uses FM for node 99 of Inst file (#4)
|
|---|
| 58 | N DA,DIC,DIQ,DR
|
|---|
| 59 | K QACSIT,QACSITE
|
|---|
| 60 | S DIC="^DIC(4,"
|
|---|
| 61 | S DA=QACIEN
|
|---|
| 62 | S DR=99
|
|---|
| 63 | S DIQ="QACSITE"
|
|---|
| 64 | D EN^DIQ1
|
|---|
| 65 | S QACSIT=QACSITE(4,QACIEN,99)
|
|---|
| 66 | Q
|
|---|
