[613] | 1 | LRARREP ;DALISC/CKA - PRINT REPORT OF ARCHIVAL ACTIVITY;6/95
|
---|
| 2 | ;;5.2;LABORATORY;**59**;August 31,1995
|
---|
| 3 | EN ;Entry point to print an archival activity report.
|
---|
| 4 | D DT^DICRW
|
---|
| 5 | AAR S DIC(0)="AEMZ",DIC="^LAB(95.11,"
|
---|
| 6 | D ^DIC
|
---|
| 7 | G:$D(DTOUT)!($D(DUOUT))!(Y<0) EXIT
|
---|
| 8 | S LRARID=+Y
|
---|
| 9 | Q S %ZIS="Q" D ^%ZIS G:POP EXIT I '$D(IO("Q")) U IO D START G EXIT
|
---|
| 10 | S ZTRTN="START^LRARREP",ZTSAVE("LRAR*")="",ZTDESC="REPORT OF ARCHIVAL ACTIVITY" D ^%ZTLOAD,HOME^%ZIS G EXIT
|
---|
| 11 | START ; BEGINS THE PRINT OF THIS ARCHIVE REPORT
|
---|
| 12 | K ^UTILITY("DIQ1",$J) S (END,PAGE)=0 D HDR G:END EXIT
|
---|
| 13 | S DIC="^LAB(95.11,",DA=LRARID,DR=".01;1;2;3;4;5;7;7.5;8;9;10;11;15;16;18;19;20",DIQ(0)="E" D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J,95.11,DA)) W !,"RECORD DOESN'T EXIST!" G EXIT
|
---|
| 14 | NUM W !,"ARCHIVE NUMBER: ",$G(^UTILITY("DIQ1",$J,95.11,DA,.01,"E"))
|
---|
| 15 | FILE W !,"FILE: ",$G(^UTILITY("DIQ1",$J,95.11,DA,1,"E"))
|
---|
| 16 | DF W !,"DESTINATION FILE: ",$G(^UTILITY("DIQ1",$J,95.11,DA,15,"E"))
|
---|
| 17 | STAT W !,"ARCHIVAL STATUS: ",$G(^UTILITY("DIQ1",$J,95.11,DA,7,"E"))
|
---|
| 18 | SD W !,"SELECT DATE: ",$G(^UTILITY("DIQ1",$J,95.11,DA,4,"E"))
|
---|
| 19 | SEL W !,"SELECTOR: ",$G(^UTILITY("DIQ1",$J,95.11,DA,7.5,"E"))
|
---|
| 20 | ARD W !,"ARCHIVE DATE: ",$G(^UTILITY("DIQ1",$J,95.11,DA,9,"E"))
|
---|
| 21 | ARC W !,"ARCHIVER: ",$G(^UTILITY("DIQ1",$J,95.11,DA,5,"E"))
|
---|
| 22 | TASK W !,"ARCHIVE TASK NUMBER: ",$G(^UTILITY("DIQ1",$J,95.11,DA,18,"E"))
|
---|
| 23 | PD W !,"PURGE DATE: ",$G(^UTILITY("DIQ1",$J,95.11,DA,10,"E"))
|
---|
| 24 | PUR W !,"PURGER: ",$G(^UTILITY("DIQ1",$J,95.11,DA,8,"E"))
|
---|
| 25 | ADL W !,"ARCHIVE DEVICE LABEL: ",$G(^UTILITY("DIQ1",$J,95.11,DA,16,"E"))
|
---|
| 26 | BEG W !,"BEGINNING DATE: ",$G(^UTILITY("DIQ1",$J,95.11,DA,19,"E"))
|
---|
| 27 | EDT W !,"ENDING DATE: ",$G(^UTILITY("DIQ1",$J,95.11,DA,20,"E"))
|
---|
| 28 | RESULT I '$D(^LAB(95.11,LRARID,"RESULT")) W !!,"NO RESULTS"
|
---|
| 29 | ERROR W !!,"THE FOLLOWING RECORDS IN THE FILE WERE NOT MOVED BECAUSE OF ONE OR MORE ERRORS:",!
|
---|
| 30 | N REC,LINE,FILE S PAGE=0,FILE=0,REC=0,END=0 D FIL
|
---|
| 31 | W !!,"*** PLEASE KEEP THIS FOR FUTURE REFERENCE ***"
|
---|
| 32 | G END
|
---|
| 33 | FIL ;
|
---|
| 34 | S LINE="Entry # "
|
---|
| 35 | S FILE=$O(^LAB(95.11,LRARID,"RESULT","ERR",FILE)) Q:'FILE D REC
|
---|
| 36 | Q:END
|
---|
| 37 | G FIL
|
---|
| 38 | REC S REC=$O(^LAB(95.11,LRARID,"RESULT","ERR",FILE,REC)) Q:'REC S ERR=^(REC)
|
---|
| 39 | S LINE=LINE_REC_" was NOT processed because:"
|
---|
| 40 | W !!,LINE N A,B S A=1,LINE="Entry # " D ERR
|
---|
| 41 | Q:END
|
---|
| 42 | G REC
|
---|
| 43 | ERR S B=$P(ERR,";",A) Q:B="" S A=A+1
|
---|
| 44 | N Z S Z=0
|
---|
| 45 | F S Z=$O(^LAB(95.11,LRARID,"RESULT","DIERR",+B,"TEXT",Z)) Q:'Z W !?5,$G(^(Z)) D HDR:($Y+1>IOSL)
|
---|
| 46 | Q:END
|
---|
| 47 | G ERR
|
---|
| 48 | ;
|
---|
| 49 | END I $E(IOST)'="C",$Y W @IOF
|
---|
| 50 | D ^%ZISC
|
---|
| 51 | Q
|
---|
| 52 | EXIT K %ZIS,DA,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,END,ERR,LRARID,PAGE,X,Y,ZTDESC,ZTRTN,ZTSAVE
|
---|
| 53 | K ^UTILITY("DIQ1",$J)
|
---|
| 54 | D CLN^LRARU1
|
---|
| 55 | QUIT
|
---|
| 56 | HDR ;PRINT HEADING
|
---|
| 57 | I $E(IOST,1,2)="C-" W !,"Press RETURN to continue or '^' to exit: " R X:DTIME S END='$T!(X="^") Q:END
|
---|
| 58 | S PAGE=PAGE+1 W @IOF,!?25,"ARCHIVAL ACTIVITY REPORT",?(IOM-10),"Page ",$J(PAGE,3)
|
---|
| 59 | W !!?61,"Date/Time Printed"
|
---|
| 60 | D NOW^%DTC S Y=% X ^DD("DD") W !?61,$P(Y,":",1,2)
|
---|
| 61 | W !!
|
---|
| 62 | QUIT
|
---|