source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACUTL0.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1QACUTL0 ;WCIOFO/ERC/VAD - Utility for Patient Rep reports ;29 Dec 98
2 ;;2.0;Patient Representative;**10,9,17**;07/25/1995
3 ;
4DATDIV ;
5 D DATE Q:QAQPOP
6 D DIV Q:QAQPOP
7 Q
8 ;
9DATE ;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 ;
16DIV ;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 ;
39TASK ;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
47INST(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
57SITE(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
Note: See TracBrowser for help on using the repository browser.