source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR302A.m@ 1123

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1LR302A ;DALOI/FHS - LR*5.2*302 SAVE POINTER VALUES PREINSTAL;29-APR-2004
2 ;;5.2;LAB SERVICE;**302**;Sep 27,1994
3 ;Saves the pointer values for the globals being deleted. The post
4 ;routine will restore the cooresponding pointers to the installed file.
5EN ;
6 I $G(^XTMP("LR302",1,0)) D Q ;Indicates the pointers have already been saved.
7 . D BMES^LR302("Historical data previously saved")
8 ;
9 I '$G(LRDBUG) K ^XTMP("LR302")
10 S ^XTMP("LR302",0)=$$FMADD^XLFDT(DT,90)_U_DT_U_"LR302 PreInstall Historical Resolved Data"
11 ;
12 N ERR,FILE,FLD,FLD2,FLD9,FLDP,FLDV,IEN,IEN2,LNC,LRD,LRI,LRI2,LRI3,OUT
13SAVE642 ;Save a copy ^LAB(64.2 for checking later
14 D
15 . N LAST
16 . Q:$G(^XTMP("LRNLT642",.01))
17 . K ^XTMP("LRNLT642")
18 . S LAST=$O(^LAB(64.2,99999),-1)
19 . S ^XTMP("LRNLT642",.01)=LAST
20 . S ^XTMP("LRNLT642",0)=$$HTFM^XLFDT($H+90,1)_U_DT_U_"LAB(64.2 Save"
21 . M ^XTMP("LRNLT642",1)=^LAB(64.2)
2260 ;Save values for file # 60.01,95.3
23 D PRT(60)
24 K ^XTMP("LR302",60.01),IEN,IEN2,FLD
25 S FLD=95.3
26 S IEN=0 F S IEN=$O(^LAB(60,IEN)) Q:IEN<1 D
27 . S IEN2=0 F S IEN2=$O(^LAB(60,IEN,1,IEN2)) Q:IEN2<1 D
28 . . D SAVE(60.01,IEN2_","_IEN_",",FLD,95.3)
29 Q:$G(LRDBUG)
3061 ;Save values from ^LAB(61 fields .09,.0961
31 D PRT(61)
32 K ^XTMP("LR302",61),OUT,ERR
33 S FLD=".09;.0961"
34 S LRI=0 F S LRI=$O(^LAB(61,LRI)) Q:LRI<1 D
35 . D SAVE(61,LRI_",",FLD,"")
36 Q:$G(LRDBUG)
376205 ;Save values from ^LAB(62.05 field 4
38 D PRT(62.05)
39 K ^XTMP("LR302",62.05),OUT,ERR
40 S FLD=4,LRI=0
41 F S LRI=$O(^LAB(62.05,LRI)) Q:LRI<1 D
42 . D SAVE(62.05,LRI_",",FLD,"")
43 Q:$G(LRDBUG)
44624 ;Extract data from ^LAB(62.4, field .14
45 D PRT(62.4)
46 K FLD,IEN,^XTMP("LR302",62.4)
47 S FLD=.14
48 S IEN=0 F S IEN=$O(^LAB(62.4,IEN)) Q:IEN<1 D
49 . D SAVE(62.4,IEN_",",FLD,"")
50 Q:$G(LRDBUG)
51628 ;Save values from ^LAHM(62.8 fields 1.13,1.23,2.13,2.23,2.33
52 D PRT(62.8)
53 K OUT,ERR,FLD,FLD9,VAL,FLDV,IENX
54 K ^XTMP("LR302",62.801)
55 S FLD9="1.14;1.24;2.14;2.24;2.34",IEN=0
56 S FLD="1.13;1.23;2.13;2.23;2.33"
57 F S IEN=$O(^LAHM(62.8,IEN)) Q:IEN<1 D
58 . S IEN2=0 F S IEN2=$O(^LAHM(62.8,IEN,10,IEN2)) Q:IEN2<1 D
59 . . S IENX=IEN2_","_IEN_"," D SAVE(62.801,IENX,FLD,"")
60 . . D SAVE(62.801,IENX,FLD9,95.3)
61 Q:$G(LRDBUG)
626285 ;Extract data from ^LAHM(62.85 field .05
63 D PRT(62.85)
64 K IEN,FLD,OUT,ERR
65 K ^XTMP("LR302",62.85)
66 S IEN=0,FLD=.05 F S IEN=$O(^LAHM(62.85,IEN)) Q:IEN<1 D
67 . D SAVE(62.85,IEN_",",FLD,"")
68 Q:$G(LRDBUG)
69629 ; Extract data from ^LAHM(62.9,,60 fields 1.15,1.25,2.15,2.25,2.35
70 D PRT(62.9)
71 K IEN,IEN2,IENX,FLD,FLD9,OUT,ERR
72 K ^XTMP("LR302",62.9001)
73 S FLD="1.15;1.25;2.15;2.25;2.35"
74 S FLD9="1.16;1.26;2.16;2.26;2.36",IEN=0
75 F S IEN=$O(^LAHM(62.9,IEN)) Q:IEN<1 D
76 . S IEN2=0 F S IEN2=$O(^LAHM(62.9,IEN,60,IEN2)) Q:IEN2<1 D
77 . . S IENX=IEN2_","_IEN_"," D SAVE(62.9001,IENX,FLD,"")
78 . . D SAVE(62.9001,IENX,FLD9,95.3)
79 Q:$G(LRDBUG)
80 G 642
816402 ;Save values from ^LAM(IEN,5,IEN2,1 fields
82 N FLD2,OUT,ERR,LRD,IEN2,LRI2,LRI3
83 S FLD2=".01;1"
84 S LRI2=0 F S LRI2=$O(^LAM(LRI,5,LRI2)) Q:LRI2<1 D
85 . S LRI3=0 F S LRI3=$O(^LAM(LRI,5,LRI2,1,LRI3)) Q:LRI3<1 D
86 . . S IEN2=LRI3_","_LRI2_","_LRI_","
87 . . D SAVE(64.02,IEN2,4,95.3)
88 . . D SAVE(64.02,IEN2,FLD2,"")
89 Q
90642 ;Save values from ^LAB(64.2 1,4,7,8,9,15
91 D PRT(64.2)
92 K FLD,IEN,^XTMP("LR302",64.2)
93 S FLD="1;4;7;8;9;15"
94 S IEN=0 F S IEN=$O(^LAB(64.2,IEN)) Q:IEN<1 D
95 . D SAVE(64.2,IEN_",",FLD,"")
96 Q:$G(LRDBUG)
97682 ;Extract date for ^LRO(68.2, field .14
98 D PRT(68.2)
99 K FLD,IEN,^XTMP("LR302",68.2)
100 S FLD=.14
101 S IEN=0 F S IEN=$O(^LRO(68.2,IEN)) Q:IEN<1 D
102 . D SAVE(68.2,IEN_",",FLD,"")
103 Q:$G(LRDBUG)
104696 ;
105 D PRT(69.6)
106 K FLD,FLD2,IEN,IEN2
107 K ^XTMP("LR302",69.6),^(69.64)
108 S FLD=6,FLD2=5,IEN=0
109 F S IEN=$O(^LRO(69.6,IEN)) Q:IEN<1 D
110 . D SAVE(69.6,IEN_",",FLD,"")
111 . S IEN2=0 F S IEN2=$O(^LRO(69.6,IEN,2,IEN2)) Q:IEN2<1 D
112 . . D SAVE(69.64,IEN2_","_IEN_",",FLD2,"")
113 Q:$G(LRDBUG)
114 S ^XTMP("LR302",1,0)=$$NOW^XLFDT_U_"Historical pointers saved"
115 Q
116SAVE(FILE,IENX,FLD,LNC) ;Save Data (FILE #,IEN,Fields,95.3)
117 K OUT,ERR,VAL,FLDP,FLDV
118 I $G(IEN),(IEN#400=0) W "."
119 D GETS^DIQ(FILE,IENX,FLD,"E","OUT","ERR")
120 F FLDP=1:1 S FLDV=$P(FLD,";",FLDP) Q:'$L(FLDV) D
121 . S VAL=$G(OUT(FILE,IENX,FLDV,"E")) I $L(VAL) D
122 . . S ^XTMP("LR302",FILE,IENX,FLDV)=$S(LNC=95.3:+VAL,1:VAL)
123 Q
124PRT(FILE) ;Display file name
125 D BMES^LR302("Saving File #"_FILE_" data.")
126 W !
127 Q
Note: See TracBrowser for help on using the repository browser.