71 lines
2.8 KiB
Mathematica
71 lines
2.8 KiB
Mathematica
LRARNPX ;SLC/MRH/FHS - NEW PERSON CONVERSION FOR ^LAR("Z" ; 1/23/93
|
|
;;5.2;LAB SERVICE;**59,150**;Sep 27, 1994
|
|
EN ;
|
|
I ('$G(DUZ)!('$D(DUZ(0)))) W !!?10,$C(7),"Please do ^XUP ",!! Q
|
|
N LRZD0,LRAC,LRDSC,LRDT,LRIO,LRJOB,X,ZTSK
|
|
D DEVICE^LRARNPX0 I LRIO="POP" Q
|
|
D QUE
|
|
D WRAPUP
|
|
Q
|
|
DQ ;
|
|
Q:'$D(ZTQUEUED)
|
|
N LRZD0,LRFILE,LRLST,LRTSK
|
|
S LRFILE="LAR-63.9999",LRZD0=0,(LRST,LRJOB)=1,LRTSK=$G(ZTSK)
|
|
; ^XTMP("LR52","LAR-63.9999",LRJOB,0) is the last record converted successfully
|
|
K ^XTMP("LR52",LRFILE),^XTMP("LR52TIME",LRFILE)
|
|
S ^XTMP("LR52",LRFILE,LRJOB,0)=0
|
|
S ^XTMP("LR52TIME",LRFILE,LRJOB)=$$NOW^LRAFUNC1
|
|
F S LRLST=LRZD0,LRZD0=+$O(^LAR("Z",LRZD0)) Q:LRZD0<1 D
|
|
. D CH,MI
|
|
. S ^XTMP("LR52",LRFILE,LRJOB,0)=LRZD0
|
|
S $P(^XTMP("LR52TIME",LRFILE,LRJOB),U,2)=$$NOW^LRAFUNC1
|
|
D OUT^LRARNPX1
|
|
D WRAPUP
|
|
Q
|
|
QUE ;
|
|
; Task off JOB to convert file 63.9999
|
|
S ZTIO=""
|
|
S (LRDSC,ZTDESC)="LAB Conversion File 63.9999 (ARCHIVED LR DATA)"
|
|
S ZTSAVE("LRIO")=LRIO,ZTRTN="DQ^LRARNPX" D ^%ZTLOAD,DISP
|
|
Q
|
|
CH ; change pointers in CHEM HEM, TOX, RIA, SER, etc. subfile 63.999904
|
|
; sub("CH") Change REQUESTING PERSON field .1 pointer
|
|
; ^LAR("Z",LRDFN,"CH",LRIDT,"NPC")=1 Indicates this record has been
|
|
;converted to File 200. This node is used when restoring arch records.
|
|
; "NPC")=2 indicates record processed but no provider number
|
|
N LRSB,LRZD1,LRPRV
|
|
S LRSB(0)="CH"
|
|
S LRZD1=0 F S LRZD1=$O(^LAR("Z",LRZD0,"CH",LRZD1)) Q:'LRZD1 D
|
|
. Q:$D(^LAR("Z",LRZD0,"CH",LRZD1,"NPC"))#2
|
|
. S LRD0=$G(^LAR("Z",LRZD0,"CH",LRZD1,0)),LRPRV=$P(LRD0,U,10)
|
|
. I 'LRPRV S ^LAR("Z",LRZD0,"CH",LRZD1,"NPC")=2 Q
|
|
. I LRPRV D
|
|
.. S $P(LRD0,U,10)=$$PROV^LRARNPX1("63.999904,.1",LRPRV,.LRSB)
|
|
.. S ^LAR("Z",LRZD0,"CH",LRZD1,0)=LRD0,^("NPC")=1
|
|
Q
|
|
MI ; change pointers in MICROBIOLOGY subfile 63.999905
|
|
; sub("MI") Change PHYSICIAN field .07 pointer
|
|
; ^LAR("Z",LRDFN,"MI",LRIDT,"NPC")=1 Indicates this record has been
|
|
; converted to File 200. This node is used when restoring arc records.
|
|
; "NPC")=2 indicates record processed but no provider number
|
|
N LRSB,LRZD1,LRPRV
|
|
S LRSB(0)="MI"
|
|
S LRZD1=0 F S LRZD1=$O(^LAR("Z",LRZD0,"MI",LRZD1)) Q:'LRZD1 D
|
|
. Q:$D(^LAR("Z",LRZD0,"MI",LRZD1,"NPC"))#2
|
|
. S LRPRV=$P($G(^LAR("Z",LRZD0,"MI",LRZD1,0)),U,7)
|
|
. I 'LRPRV S ^LAR("Z",LRZD0,"MI",LRZD1,"NPC")=2 Q
|
|
. I LRPRV S $P(^LAR("Z",LRZD0,"MI",LRZD1,0),U,7)=$$PROV^LRARNPX1("63.999905,.07",LRPRV,.LRSB),^("NPC")=1
|
|
Q
|
|
DISP ; to display to the user the tasked job descriptions and TASK
|
|
; numbers for the different conversion routines
|
|
W $C(7),!!!,$C(7),"Task # "_ZTSK,!,"with the description of '"_LRDSC_"'"
|
|
W !,"has been scheduled to run "
|
|
W $$DDDATE^LRAFUNC1($$CDHTFM^LRAFUNC1(ZTSK("D")),2)_".",$C(7),!
|
|
K ZTSK,ZTDTH
|
|
Q
|
|
WRAPUP ;
|
|
K ZTSK,ZTDESC,ZTRTN,ZTSAVE,ZTIO,ZTDTH,%ZIS,POP,X,Y,%,%X,%Y,DIC,I
|
|
K LRTSK,LRD0,LRZD0,LRD1,LRZD1,LRLST,LRFILE,LRIO,LRJOB,LRDSC,LRAC,LRPRV
|
|
K LRSB,LRST,LRDT,LRSORT
|
|
Q
|