| [613] | 1 | LRARCHD ;SLC/MRH/DALISC/FHS - DEARCHIVE FROM ^LAR TO ^LR ;2/5/91 12:31 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**59,125**;Sep 27, 1994
|
|---|
| 3 | ;ONCE THE GLOBAL ^LAR HAS BEEN PLACED ON THE SYSTEM
|
|---|
| 4 | START ;
|
|---|
| 5 | W !,"This option will restore Laboratory data that has been archived ",!,"This data will again be removed from the ^LR global the next time the",!,"ARCHIVE program runs.",!!
|
|---|
| 6 | ASK W !,"Do you wish to continue " S U="^",%=2 D YN^DICN G TEXT:%=0,STOP:%'=1
|
|---|
| 7 | I '$D(^LAR("Z")) W !,$C(7),"The LAR global is not on the system. Load it",!,"from where you have it stored and start again." G STOP
|
|---|
| 8 | NPC ;Check to ensure the routine ^LRARNPXA has been ran - 'it sets the 'NPC' node
|
|---|
| 9 | W !!?5,"Checking ^LAR( for New Person Conversion ",!
|
|---|
| 10 | S LRDFN=0 F CNT=1:1:80 S LRDFN=$O(^LAR("Z",LRDFN)) Q:LRDFN<1!($G(LRNOP)) W "." D
|
|---|
| 11 | . S LRIDT=$O(^LAR("Z",LRDFN,"CH",0)) Q:'LRIDT I '$G(^(LRIDT,"NPC")) S LRNOP=1
|
|---|
| 12 | K LRDFN,LRIDT,CNT I $G(LRNOP) W !!,"You must FIRST run the option",!," 'Convert archived data to use New Person file",!,$C(7) G CONV
|
|---|
| 13 | W !!?5,"File appears to have been Converted to New Person.",!!
|
|---|
| 14 | S %=2 W !,"Do you wish to restore data for ALL patients " D YN^DICN G ALL:%=1,TEXT:%=0,STOP:%<0
|
|---|
| 15 | PT K LRCHND,LRMIND S DIC=0 D ^LRDPA G:Y'>0 STOP
|
|---|
| 16 | I '$L(SSN) W !,$C(7),"No identifier defined for this patient" G STOP
|
|---|
| 17 | I '$D(^LAR("SSN",SSN(2)))&('$D(^(SSN))) W !,$C(7),"NO ARCHIVED DATA EXISTS FOR THIS PATIENT! " G PT
|
|---|
| 18 | S LRDFN=$S($D(^LAR("SSN",SSN(2))):$O(^(SSN(2),0)),$D(^LAR("SSN",SSN)):$O(^(SSN,0))),LRCHKSUM=$P(^LAR("Z",LRDFN,0),U,1,3)
|
|---|
| 19 | I LRCHKSUM'=$P(^LR(LRDFN,0),"^",1,3) W !,$C(7),"The file entries do not match, I can go no further!" G PT
|
|---|
| 20 | I $D(^LAR("Z",LRDFN,"CH",0)) S LRCHND=^(0) S $P(^(0),U,2)="63.04D"
|
|---|
| 21 | I $D(^LR(LRDFN,"CH",0)) K ^LAR("Z",LRDFN,"CH",0)
|
|---|
| 22 | I $D(^LAR("Z",LRDFN,"MI",0)) S LRMIND=^(0) S $P(^(0),U,2)="63.05DA"
|
|---|
| 23 | I $D(^LR(LRDFN,"MI",0)) K ^LAR("Z",LRDFN,"MI",0)
|
|---|
| 24 | S Z=^LR(LRDFN,0),%X="^LAR(""Z"",LRDFN,",%Y="^LR(LRDFN," D %XY^%RCR S ^LR(LRDFN,0)=Z S:$D(LRCHND) ^LAR("Z",LRDFN,"CH",0)=LRCHND S:$D(LRMIND) ^LAR("Z",LRDFN,"MI",0)=LRMIND W !,$C(7),"DONE FOR THIS PATIENT",! G PT
|
|---|
| 25 | EXIT ;
|
|---|
| 26 | W !,$C(7),"ALL DONE !",$C(7)
|
|---|
| 27 | STOP K %X,%Y,%,SSN,LRCHND,LRMIND,LRDFN,LRIDT,LRNOP,CNT,LRCHKSUM,DIC Q
|
|---|
| 28 | TEXT W !!,"Just answer ""YES"" or ""NO""." G ASK
|
|---|
| 29 | ALL W !,"This may take some time!",! F LRDFN=0:0 S LRDFN=$O(^LAR("Z",LRDFN)) Q:LRDFN<1 D
|
|---|
| 30 | .I $D(^LAR("Z",LRDFN,"CH",0)) S LRCHND=^(0) S $P(^(0),U,2)="63.04D"
|
|---|
| 31 | .I $D(^LR(LRDFN,"CH",0)) K ^LAR("Z",LRDFN,"CH",0)
|
|---|
| 32 | .I $D(^LAR("Z",LRDFN,"MI",0)) S LRMIND=^(0) S $P(^(0),U,2)="63.05DA"
|
|---|
| 33 | .I $D(^LR(LRDFN,"MI",0)) K ^LAR("Z",LRDFN,"MI",0)
|
|---|
| 34 | .S Z=^LR(LRDFN,0),%X="^LAR(""Z"",LRDFN,",%Y="^LR(LRDFN," D %XY^%RCR S ^LR(LRDFN,0)=Z
|
|---|
| 35 | G EXIT
|
|---|
| 36 | CONV ;
|
|---|
| 37 | W !,"Would you like to run the conversion option now " S %=1 D YN^DICN
|
|---|
| 38 | I %'=1 G STOP
|
|---|
| 39 | D ^LRARNPX G STOP
|
|---|
| 40 | Q
|
|---|
| 41 | EN ;
|
|---|
| 42 | FIND K DIC S DIC=0 D ^LRDPA Q:LRDFN<1 S DA=$O(^LR(LRDFN,"T",0)) I DA="" W !,"No data archived." G FIND
|
|---|
| 43 | S DIC="^LAB(69.9,1,6,",DR=0 D EN^DIQ F DA=DA:0 S DA=$O(^LR(LRDFN,"T",DA)) Q:DA<1 S K=0 D EN^DIQ
|
|---|
| 44 | G FIND
|
|---|
