source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACARCH.m@ 789

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

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1QACARCH ;HISC/CEW - Routine to archive selected records ;1/17/95 11:19
2 ;;2.0;Patient Representative;**9**;07/25/1995
3INFO ;
4 W !!?5,"Using this option does not purge the records archived."
5 W !?5,"At the device prompt, save the output to a file,"
6 W !?5,"capture the output for a word processing package,"
7 W !?5,"or send it to a printer for a hard copy report."
8 ;
9MAIN ;
10 S QAQPOP=0
11 D DATDIV^QACUTL0 G:QAQPOP EXIT
12 K DIC,FLDS,L,BY,FR,TO,DHD
13 S L=0,DIC="^QA(745.1,"
14 S FLDS="1;S2,.01,2,3,22;C1,21,.01;L65,,25;C1",DHD="@@"
15 S DIOBEG="W !!,""Archived Patient Rep Contact Records"",!,QAQ2HED"
16 ;
17 ; report is not by division
18 I +$G(QACDV)'=1 D
19 . S BY="1"
20 . S FR(1)=QAQNBEG,TO(1)=QAQNEND
21 ;
22 ; report is by division
23 I +$G(QACDV)=1 D
24 . S BY="37;S3;C25,1"
25 . S FR(1)="@",TO(1)=""
26 . I +$G(QAC1DIV) D
27 . . S QACDVNAM="" D INST^QACUTL0(QAC1DIV,.QACDVNAM)
28 . . S (FR(1),TO(1))=QACDVNAM
29 . S FR(2)=QAQNBEG,TO(2)=QAQNEND
30 D EN1^DIP
31EXIT ;
32 K DIC,FLDS,L,BY,FR,TO,DHD,DIP,DIOBEG,QACDV,QAC1DIV,QAQPOP,QACDVNAM
33 K QAQNBEG,QAQNEND
34 D K^QAQDATE
35 Q
Note: See TracBrowser for help on using the repository browser.