LRARCAM4 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT PART 1
;;5.2;LAB SERVICE;**59**;August 31,1995
;same as LRCAPAM5 except for archived wkld file reference
EN ;
INST ;
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
;Check for lab archival activity in archived status
S LRART=67.9,LRARC=0 S LRARC=$O(^LAB(95.11,"O",2,LRART,LRARC))
I LRARC="" D ERROR
DIV ;
K DIC
S DIC("A")="Select Division: "
S DIC("B")=$P($G(^DIC(4,+DUZ(2),0)),U)
S DIC=4,DIC(0)="AQENMZ"
D ^DIC G:Y<1 EXIT S LRDA=Y,LRDA=$O(^LAR(67.99999,1,1,"B",+LRDA,0))
MONTHS ;
K DA,DIC
S DA(1)=LRDA(1),DA=+LRDA,DIC(0)="AQEN"
S DIC="^LAR(67.99999,"_DA(1)_",1,"_DA_",1,"
S DIC("A")="Select Month: "
F D ^DIC Q:Y<1 S LRRPTM(Y)=""
I '$O(LRRPTM(0)) W !!?5,"Nothing Selected " G EXIT
DATTYP ;
K DIR
S DIR(0)="S^1:All workload;2:LMIP reportable workload;3:Non-LMIP workload"
S DIR("A")="Enter the number for the workload data to report"
S DIR("B")=1
S DIR("?")=" reportable for LMIP."
S DIR("?",1)="1 - will include all workload data in the file, period."
S DIR("?",2)=" "
S DIR("?",3)="2 - will include only workload which is associated with a"
S DIR("?",4)=" WKLD code that is marked as reportable for LMIP uses."
S DIR("?",5)=" "
S DIR("?",6)="3 - will include any workload which is not marked as"
D ^DIR G:($D(DTOUT))!($D(DUOUT)) EXIT
S LRDTYP=Y,LRHD0=$S(LRDTYP=1:"ALL WORKLOAD DATA FOR: ",LRDTYP=2:"LMIP WORKLOAD DATA FOR: ",1:"Non-LMIP WORKLOAD DATA FOR: ")
REPTYP ;
K DIR S DIR(0)="S^1:CDR report"
S:LRDTYP=2 DIR(0)=DIR(0)_";2:LMIP report;3:CDR and LMIP reports"
S DIR("A")="Enter the number for the report(s) you want printed"
S DIR("B")=1
D ^DIR G:($D(DTOUT))!($D(DUOUT)) EXIT S LRRTYP=Y
DETSUM ;
I (LRRTYP=1)!(LRRTYP=3) D G:$G(LREND) EXIT
.W !!,"CDR format selection: "
.K DIR,X,Y S DIR(0)="S^1:Detailed report;2:Summary report"
.D ^DIR
.I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
.S LRRPT=+X
G ^LRARCAM5
EXIT ;
D ^%ZISC
D KILLALL^LRARCU
K ^TMP($J,"RCS14-4"),^TMP($J,"LMIP"),LRERR
Q
ERROR W !!,$C(7),"This file does not have an archival activity with the status of archived."
W !,"Therefore this file may be incomplete if archiving is still in progress."
W !!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCAM4 2317 printed Nov 22, 2024@17:19:01 Page 2
LRARCAM4 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT PART 1
+1 ;;5.2;LAB SERVICE;**59**;August 31,1995
+2 ;same as LRCAPAM5 except for archived wkld file reference
EN ;
INST ;
+1 KILL LRDA,LRRPTM
SET LRDA(1)=1
IF '$DATA(^LAR(67.99999,1,0))
WRITE !!?10,"Sorry, there is no primary institution in file 67.99999. Exiting."
GOTO EXIT
+2 ;Check for lab archival activity in archived status
+3 SET LRART=67.9
SET LRARC=0
SET LRARC=$ORDER(^LAB(95.11,"O",2,LRART,LRARC))
+4 IF LRARC=""
DO ERROR
DIV ;
+1 KILL DIC
+2 SET DIC("A")="Select Division: "
+3 SET DIC("B")=$PIECE($GET(^DIC(4,+DUZ(2),0)),U)
+4 SET DIC=4
SET DIC(0)="AQENMZ"
+5 DO ^DIC
if Y<1
GOTO EXIT
SET LRDA=Y
SET LRDA=$ORDER(^LAR(67.99999,1,1,"B",+LRDA,0))
MONTHS ;
+1 KILL DA,DIC
+2 SET DA(1)=LRDA(1)
SET DA=+LRDA
SET DIC(0)="AQEN"
+3 SET DIC="^LAR(67.99999,"_DA(1)_",1,"_DA_",1,"
+4 SET DIC("A")="Select Month: "
+5 FOR
DO ^DIC
if Y<1
QUIT
SET LRRPTM(Y)=""
+6 IF '$ORDER(LRRPTM(0))
WRITE !!?5,"Nothing Selected "
GOTO EXIT
DATTYP ;
+1 KILL DIR
+2 SET DIR(0)="S^1:All workload;2:LMIP reportable workload;3:Non-LMIP workload"
+3 SET DIR("A")="Enter the number for the workload data to report"
+4 SET DIR("B")=1
+5 SET DIR("?")=" reportable for LMIP."
+6 SET DIR("?",1)="1 - will include all workload data in the file, period."
+7 SET DIR("?",2)=" "
+8 SET DIR("?",3)="2 - will include only workload which is associated with a"
+9 SET DIR("?",4)=" WKLD code that is marked as reportable for LMIP uses."
+10 SET DIR("?",5)=" "
+11 SET DIR("?",6)="3 - will include any workload which is not marked as"
+12 DO ^DIR
if ($DATA(DTOUT))!($DATA(DUOUT))
GOTO EXIT
+13 SET LRDTYP=Y
SET LRHD0=$SELECT(LRDTYP=1:"ALL WORKLOAD DATA FOR: ",LRDTYP=2:"LMIP WORKLOAD DATA FOR: ",1:"Non-LMIP WORKLOAD DATA FOR: ")
REPTYP ;
+1 KILL DIR
SET DIR(0)="S^1:CDR report"
+2 if LRDTYP=2
SET DIR(0)=DIR(0)_";2:LMIP report;3:CDR and LMIP reports"
+3 SET DIR("A")="Enter the number for the report(s) you want printed"
+4 SET DIR("B")=1
+5 DO ^DIR
if ($DATA(DTOUT))!($DATA(DUOUT))
GOTO EXIT
SET LRRTYP=Y
DETSUM ;
+1 IF (LRRTYP=1)!(LRRTYP=3)
Begin DoDot:1
+2 WRITE !!,"CDR format selection: "
+3 KILL DIR,X,Y
SET DIR(0)="S^1:Detailed report;2:Summary report"
+4 DO ^DIR
+5 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+6 SET LRRPT=+X
End DoDot:1
if $GET(LREND)
GOTO EXIT
+7 GOTO ^LRARCAM5
EXIT ;
+1 DO ^%ZISC
+2 DO KILLALL^LRARCU
+3 KILL ^TMP($JOB,"RCS14-4"),^TMP($JOB,"LMIP"),LRERR
+4 QUIT
ERROR WRITE !!,$CHAR(7),"This file does not have an archival activity with the status of archived."
+1 WRITE !,"Therefore this file may be incomplete if archiving is still in progress."
+2 WRITE !!
+3 QUIT
