source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRARCAM4.m@ 1801

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1LRARCAM4 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT PART 1
2 ;;5.2;LAB SERVICE;**59**;August 31,1995
3 ;same as LRCAPAM5 except for archived wkld file reference
4EN ;
5INST ;
6 K LRDA,LRRPTM S LRDA(1)=1 I '$D(^LAR(67.99999,1,0)) W !!?10,"Sorry, there is no primary institution in file 67.99999. Exiting." G EXIT
7 ;Check for lab archival activity in archived status
8 S LRART=67.9,LRARC=0 S LRARC=$O(^LAB(95.11,"O",2,LRART,LRARC))
9 I LRARC="" D ERROR
10DIV ;
11 K DIC
12 S DIC("A")="Select Division: "
13 S DIC("B")=$P($G(^DIC(4,+DUZ(2),0)),U)
14 S DIC=4,DIC(0)="AQENMZ"
15 D ^DIC G:Y<1 EXIT S LRDA=Y,LRDA=$O(^LAR(67.99999,1,1,"B",+LRDA,0))
16MONTHS ;
17 K DA,DIC
18 S DA(1)=LRDA(1),DA=+LRDA,DIC(0)="AQEN"
19 S DIC="^LAR(67.99999,"_DA(1)_",1,"_DA_",1,"
20 S DIC("A")="Select Month: "
21 F D ^DIC Q:Y<1 S LRRPTM(Y)=""
22 I '$O(LRRPTM(0)) W !!?5,"Nothing Selected " G EXIT
23DATTYP ;
24 K DIR
25 S DIR(0)="S^1:All workload;2:LMIP reportable workload;3:Non-LMIP workload"
26 S DIR("A")="Enter the number for the workload data to report"
27 S DIR("B")=1
28 S DIR("?")=" reportable for LMIP."
29 S DIR("?",1)="1 - will include all workload data in the file, period."
30 S DIR("?",2)=" "
31 S DIR("?",3)="2 - will include only workload which is associated with a"
32 S DIR("?",4)=" WKLD code that is marked as reportable for LMIP uses."
33 S DIR("?",5)=" "
34 S DIR("?",6)="3 - will include any workload which is not marked as"
35 D ^DIR G:($D(DTOUT))!($D(DUOUT)) EXIT
36 S LRDTYP=Y,LRHD0=$S(LRDTYP=1:"ALL WORKLOAD DATA FOR: ",LRDTYP=2:"LMIP WORKLOAD DATA FOR: ",1:"Non-LMIP WORKLOAD DATA FOR: ")
37REPTYP ;
38 K DIR S DIR(0)="S^1:CDR report"
39 S:LRDTYP=2 DIR(0)=DIR(0)_";2:LMIP report;3:CDR and LMIP reports"
40 S DIR("A")="Enter the number for the report(s) you want printed"
41 S DIR("B")=1
42 D ^DIR G:($D(DTOUT))!($D(DUOUT)) EXIT S LRRTYP=Y
43DETSUM ;
44 I (LRRTYP=1)!(LRRTYP=3) D G:$G(LREND) EXIT
45 .W !!,"CDR format selection: "
46 .K DIR,X,Y S DIR(0)="S^1:Detailed report;2:Summary report"
47 .D ^DIR
48 .I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
49 .S LRRPT=+X
50 G ^LRARCAM5
51EXIT ;
52 D ^%ZISC
53 D KILLALL^LRARCU
54 K ^TMP($J,"RCS14-4"),^TMP($J,"LMIP"),LRERR
55 Q
56ERROR W !!,$C(7),"This file does not have an archival activity with the status of archived."
57 W !,"Therefore this file may be incomplete if archiving is still in progress."
58 W !!
59 Q
Note: See TracBrowser for help on using the repository browser.