source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARNPX.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1LRARNPX ;SLC/MRH/FHS - NEW PERSON CONVERSION FOR ^LAR("Z" ; 1/23/93
2 ;;5.2;LAB SERVICE;**59,150**;Sep 27, 1994
3EN ;
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
10DQ ;
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
25QUE ;
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
31CH ; 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
46MI ; 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
59DISP ; 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
66WRAPUP ;
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
Note: See TracBrowser for help on using the repository browser.