| [613] | 1 | LRARNPX ;SLC/MRH/FHS - NEW PERSON CONVERSION FOR ^LAR("Z" ; 1/23/93
|
|---|
| 2 | ;;5.2;LAB SERVICE;**59,150**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | I ('$G(DUZ)!('$D(DUZ(0)))) W !!?10,$C(7),"Please do ^XUP ",!! Q
|
|---|
| 5 | N LRZD0,LRAC,LRDSC,LRDT,LRIO,LRJOB,X,ZTSK
|
|---|
| 6 | D DEVICE^LRARNPX0 I LRIO="POP" Q
|
|---|
| 7 | D QUE
|
|---|
| 8 | D WRAPUP
|
|---|
| 9 | Q
|
|---|
| 10 | DQ ;
|
|---|
| 11 | Q:'$D(ZTQUEUED)
|
|---|
| 12 | N LRZD0,LRFILE,LRLST,LRTSK
|
|---|
| 13 | S LRFILE="LAR-63.9999",LRZD0=0,(LRST,LRJOB)=1,LRTSK=$G(ZTSK)
|
|---|
| 14 | ; ^XTMP("LR52","LAR-63.9999",LRJOB,0) is the last record converted successfully
|
|---|
| 15 | K ^XTMP("LR52",LRFILE),^XTMP("LR52TIME",LRFILE)
|
|---|
| 16 | S ^XTMP("LR52",LRFILE,LRJOB,0)=0
|
|---|
| 17 | S ^XTMP("LR52TIME",LRFILE,LRJOB)=$$NOW^LRAFUNC1
|
|---|
| 18 | F S LRLST=LRZD0,LRZD0=+$O(^LAR("Z",LRZD0)) Q:LRZD0<1 D
|
|---|
| 19 | . D CH,MI
|
|---|
| 20 | . S ^XTMP("LR52",LRFILE,LRJOB,0)=LRZD0
|
|---|
| 21 | S $P(^XTMP("LR52TIME",LRFILE,LRJOB),U,2)=$$NOW^LRAFUNC1
|
|---|
| 22 | D OUT^LRARNPX1
|
|---|
| 23 | D WRAPUP
|
|---|
| 24 | Q
|
|---|
| 25 | QUE ;
|
|---|
| 26 | ; Task off JOB to convert file 63.9999
|
|---|
| 27 | S ZTIO=""
|
|---|
| 28 | S (LRDSC,ZTDESC)="LAB Conversion File 63.9999 (ARCHIVED LR DATA)"
|
|---|
| 29 | S ZTSAVE("LRIO")=LRIO,ZTRTN="DQ^LRARNPX" D ^%ZTLOAD,DISP
|
|---|
| 30 | Q
|
|---|
| 31 | CH ; change pointers in CHEM HEM, TOX, RIA, SER, etc. subfile 63.999904
|
|---|
| 32 | ; sub("CH") Change REQUESTING PERSON field .1 pointer
|
|---|
| 33 | ; ^LAR("Z",LRDFN,"CH",LRIDT,"NPC")=1 Indicates this record has been
|
|---|
| 34 | ;converted to File 200. This node is used when restoring arch records.
|
|---|
| 35 | ; "NPC")=2 indicates record processed but no provider number
|
|---|
| 36 | N LRSB,LRZD1,LRPRV
|
|---|
| 37 | S LRSB(0)="CH"
|
|---|
| 38 | S LRZD1=0 F S LRZD1=$O(^LAR("Z",LRZD0,"CH",LRZD1)) Q:'LRZD1 D
|
|---|
| 39 | . Q:$D(^LAR("Z",LRZD0,"CH",LRZD1,"NPC"))#2
|
|---|
| 40 | . S LRD0=$G(^LAR("Z",LRZD0,"CH",LRZD1,0)),LRPRV=$P(LRD0,U,10)
|
|---|
| 41 | . I 'LRPRV S ^LAR("Z",LRZD0,"CH",LRZD1,"NPC")=2 Q
|
|---|
| 42 | . I LRPRV D
|
|---|
| 43 | .. S $P(LRD0,U,10)=$$PROV^LRARNPX1("63.999904,.1",LRPRV,.LRSB)
|
|---|
| 44 | .. S ^LAR("Z",LRZD0,"CH",LRZD1,0)=LRD0,^("NPC")=1
|
|---|
| 45 | Q
|
|---|
| 46 | MI ; change pointers in MICROBIOLOGY subfile 63.999905
|
|---|
| 47 | ; sub("MI") Change PHYSICIAN field .07 pointer
|
|---|
| 48 | ; ^LAR("Z",LRDFN,"MI",LRIDT,"NPC")=1 Indicates this record has been
|
|---|
| 49 | ; converted to File 200. This node is used when restoring arc records.
|
|---|
| 50 | ; "NPC")=2 indicates record processed but no provider number
|
|---|
| 51 | N LRSB,LRZD1,LRPRV
|
|---|
| 52 | S LRSB(0)="MI"
|
|---|
| 53 | S LRZD1=0 F S LRZD1=$O(^LAR("Z",LRZD0,"MI",LRZD1)) Q:'LRZD1 D
|
|---|
| 54 | . Q:$D(^LAR("Z",LRZD0,"MI",LRZD1,"NPC"))#2
|
|---|
| 55 | . S LRPRV=$P($G(^LAR("Z",LRZD0,"MI",LRZD1,0)),U,7)
|
|---|
| 56 | . I 'LRPRV S ^LAR("Z",LRZD0,"MI",LRZD1,"NPC")=2 Q
|
|---|
| 57 | . I LRPRV S $P(^LAR("Z",LRZD0,"MI",LRZD1,0),U,7)=$$PROV^LRARNPX1("63.999905,.07",LRPRV,.LRSB),^("NPC")=1
|
|---|
| 58 | Q
|
|---|
| 59 | DISP ; to display to the user the tasked job descriptions and TASK
|
|---|
| 60 | ; numbers for the different conversion routines
|
|---|
| 61 | W $C(7),!!!,$C(7),"Task # "_ZTSK,!,"with the description of '"_LRDSC_"'"
|
|---|
| 62 | W !,"has been scheduled to run "
|
|---|
| 63 | W $$DDDATE^LRAFUNC1($$CDHTFM^LRAFUNC1(ZTSK("D")),2)_".",$C(7),!
|
|---|
| 64 | K ZTSK,ZTDTH
|
|---|
| 65 | Q
|
|---|
| 66 | WRAPUP ;
|
|---|
| 67 | K ZTSK,ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH,%ZIS,POP,X,Y,%,%X,%Y,DIC,I
|
|---|
| 68 | K LRTSK,LRD0,LRZD0,LRD1,LRZD1,LRLST,LRFILE,LRIO,LRJOB,LRDSC,LRAC,LRPRV
|
|---|
| 69 | K LRSB,LRST,LRDT,LRSORT
|
|---|
| 70 | Q
|
|---|
