source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAR01.m@ 730

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1LRAR01 ;DAL/HOAK EXTENSION OF LRAR00 ; 12/12/96 10:16 ;
2 ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
3INIT ;
4 ;
5 ;
6EN02 ;
7CLEAN ;
8 ; REMOVE ^LAR FOR READ TAPE IN
9 ;
10 W !,"I will now CLEAR out the global"
11 D FLAG
12 ;
13 S OK=1
14 I F1<2 W !,"Search pass has not completed. " D
15 . W "Want to CLEAR ^LAR anyway" S %=1 D YN^DICN S:%'=1 OK=0
16 Q:'OK
17 ;
18 S X=100
19 F S X=$O(^LAR(X)) Q:X="" K ^LAR(X)
20 S ^LAR("Z",0)="ARCHIVED LR DATA^63.9999"
21 I P1,$P(^LAB(69.9,1,6,P1,0),U,4)=2 S $P(^(0),U,4)=3
22 W !!,"Now read the tape back in to make sure we have a good tape."
23 W !,"Then do the PURGE pass."
24 QUIT
25EN03 ;
26PURGE ;
27 ; PURGE DATA FROM ^LR THAT IS IN ^LAR
28 D FLAG
29 ;
30 I F1<3 W !," Please clear and reload the archive global.",$C(7) Q
31 ;
32 I F1'=3 W !,"PURGE in progress, or completed. Please let it finish." Q
33 ;
34 D DEV1^LRAR01 I POP D QUIT Q
35 ;
36 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ2^LRCHIV",ZTSAVE("P1")="" D QUIT
37 . S ZTSAVE("F1")="",ZTSAVE("LR(")="" D ^%ZTLOAD D QUIT
38 ;
39DQ2 ;
40 I $P(^LAB(69.9,1,6,P1,0),U,4)'=3 D D QUIT Q
41 . W !!,"Not in the right state.",!!
42 S $P(^LAB(69.9,1,6,P1,0),U,4)=4
43 D EN^LRAR05 S $P(^LAB(69.9,1,6,P1,0),U,4)=5
44 K ^LAR("NAME"),^LAR("SSN"),^LAR("Z"),^LAB(69.9,1,"TAPE")
45 K ^LAB(69.9,1,"LRDFN"),^LAB(69.9,1,"PURGE LRDFN")
46 S ^LAR("Z",0)="ARCHIVED LR DATA^63.9999"
47 D QUIT
48 Q
49 ;
50FLAG ;
51 ; Whats happening in 69.9....
52 ;
53 S P1=$S($D(^LAB(69.9,1,"TAPE")):^("TAPE"),1:0)
54 ;
55 S F1=$S($D(^LAB(69.9,1,6,P1,0)):$P(^(0),U,4),1:0)
56 ;
57 ; ^LAB(69.9,1,6,1,0) = TEST^TEST PHYSICAL^2860808.0904^1^2860500
58 ; Set a date range for LRIDT
59 ;
60 Q
61DEV ;
62 D DEVICE^LRARCHIV
63 QUIT
64DEV1 S %ZIS="Q"
65 S:'$D(%ZIS("A")) %ZIS("A")="ERROR LOG REPORT: "
66 D ^%ZIS K %ZIS Q
67 Q
68 ;
69KILL ;
70 W ! W:$E(IOST,1,2)="P-" @IOF
71 S ZTQUE="@"
72 D ^%ZISC
73 K I,J,LRPAT,LRDAT,LRDPF,LRIDT,LRSS,LRSUB,P1,PNM,SSN,X0,X1,X2,X3
74 K ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE
75 Q
76 ;
77PRT ;
78 Q
79 S %ZIS="Q",%ZIS("A")="Printer "
80 D DEV
81 I POP D KILL Q
82 ;
83 S LRPAT=1
84 I $D(IO("Q")) S ZTRTN="LST^LRARCHIV",ZTSAVE("LRPAT")="" D
85 . S ZTDESC="Print Archive Patients" D ^%ZTLOAD G KILL
86 D LST^LRARCHIV
87QUIT D KILL
88 QUIT
Note: See TracBrowser for help on using the repository browser.