| 1 | LRAR01 ;DAL/HOAK EXTENSION OF LRAR00 ; 12/12/96 10:16 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**111**;Sep 27, 1994
|
|---|
| 3 | INIT ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | EN02 ;
|
|---|
| 7 | CLEAN ;
|
|---|
| 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
|
|---|
| 25 | EN03 ;
|
|---|
| 26 | PURGE ;
|
|---|
| 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 | ;
|
|---|
| 39 | DQ2 ;
|
|---|
| 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 | ;
|
|---|
| 50 | FLAG ;
|
|---|
| 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
|
|---|
| 61 | DEV ;
|
|---|
| 62 | D DEVICE^LRARCHIV
|
|---|
| 63 | QUIT
|
|---|
| 64 | DEV1 S %ZIS="Q"
|
|---|
| 65 | S:'$D(%ZIS("A")) %ZIS("A")="ERROR LOG REPORT: "
|
|---|
| 66 | D ^%ZIS K %ZIS Q
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | KILL ;
|
|---|
| 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 | ;
|
|---|
| 77 | PRT ;
|
|---|
| 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
|
|---|
| 87 | QUIT D KILL
|
|---|
| 88 | QUIT
|
|---|
