source: FOIAVistA/trunk/r/MEDICINE-MC/MCARAM3.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1MCARAM3 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;5/2/96 12:49
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5 ;Modules to return lab data in a local array
6 ; USAGE: S X=$$L#^MCARAM3(.A,B) , where # = integer from 7 to 12
7 ; WHERE: .A=local array into which data is placed
8 ; B=1 line of lab data
9 ; if unsuccessful, returns an error message
10 ; if successful, returns a function value of 0 and a value array:
11 ; MCA(field #) = value of field
12 ; MCA("CONT") = diagnosis line # in alphabetic form
13 ; MCA("DX,#") = line of diagnosis data
14 ; MCA("DT") = date/time in FM format
15 ;
16L12(MCA,MCD) ;Returns Field 8 = P Axis, 9 = R Axis, 10 = T Axis,
17 ; 12 = Interpreted By, Pointer to File 200
18 N MCERR
19 S MCERR=$$AR^MCARAM4(.MCA,8,MCD,11,15,3)
20 I +MCERR=2 K MCA(8) S MCERR=$$LOG^MCARAM7("2-P Axis is a null data field")
21 I +MCERR=1 K MCA(8) S MCERR=$$LOG^MCARAM7("1-P Axis not numeric")
22 I +MCERR>50 Q MCERR
23 S MCERR=$$AR^MCARAM4(.MCA,9,MCD,16,19,3)
24 I +MCERR=2 K MCA(9) S MCERR=$$LOG^MCARAM7("2-R Axis is a null data field")
25 I +MCERR=1 K MCA(9) S MCERR=$$LOG^MCARAM7("1-R Axis not numeric")
26 I +MCERR>50 Q MCERR
27 S MCERR=$$AR^MCARAM4(.MCA,10,MCD,20,31,3)
28 I +MCERR=2 K MCA(10) S MCERR=$$LOG^MCARAM7("2-T Axis is a null data field")
29 I +MCERR=1 K MCA(10) S MCERR=$$LOG^MCARAM7("1-T Axis not numeric")
30 I +MCERR>50 Q MCERR
31 I $$GRERR^MCARAM7(.MCA)=1 Q MCERR
32 S MCERR=$$AR^MCARAM4(.MCA,12,MCD,67,134) I +MCERR=2 K MCA(12) S MCERR=$$PROEFF^MCARAM3(MCA("DT"),MCERR) Q $$LOG^MCARAM7(MCERR)
33 I +MCERR>50 Q MCERR
34 S MCA(12)=$P(MCA(12),": ",2) I MCA(12)="" K MCA(12) S MCERR=$$PROEFF^MCARAM3(MCA("DT"),MCERR) Q $$LOG^MCARAM7(MCERR)
35 N MCPH S MCPH=MCA(12),MCERR=$$SLTS^MCARAM4(.MCPH),MCA(12)=MCPH K MCPH
36 I +MCERR=2 K MCA(12) S MCERR=$$PROEFF^MCARAM3(MCA("DT"),MCERR) Q $$LOG^MCARAM7(MCERR)
37 I MCA(12)["/",MCA(12)'[" " S MCA(12)=$P(MCA(12),"/")
38 I MCA(12)["/" N MCA12 S MCA(12)=$P(MCA(12),"/") F MCA12=$L(MCA(12)):-1:1 I $E(MCA(12),MCA12)=" " S MCA(12)=$E(MCA(12),(MCA12+1),$L(MCA(12))) Q
39 S:MCA(12)[" M.D.," MCA(12)=$P(MCA(12)," M.D.",1)_$P(MCA(12),"M.D.",2,99)
40 S:MCA(12)[" M.D." MCA(12)=$P(MCA(12)," M.D.",1)_","_$P(MCA(12),"M.D. ",2,99)
41 S:MCA(12)[" MD " MCA(12)=$P(MCA(12)," MD",1)_","_$P(MCA(12),"MD ",2,99)
42 I $D(^VA(200,"B",MCA(12))) S MCA(12)=$O(^(MCA(12),0)) Q 0
43 ;allow a match between DHCP provider name length and instrument name length
44 N MCNAM,MCFNAM,MCLNAM,MC12NAM,MC12FNAM,MC12LNAM
45 S MC12LNAM=$P(MCA(12),","),MC12FNAM=$P(MCA(12),",",2,99)
46 I $E(MC12FNAM)=" " S MC12FNAM=$E(MC12FNAM,2,$L(MC12FNAM))
47 S (MC12LNAM,MCLNAM)=$E(MC12LNAM,1,7),(MC12FNAM,MCFNAM)=$E(MC12FNAM,1,3)
48 S (MC12NAM,MCNAM)=MC12LNAM_","_MC12FNAM
49 I $D(^VA(200,"B",MCNAM)) S MCA(12)=$O(^(MCNAM,0)) D KNMK Q 0
50 K MCA(12) F S MCNAM=$O(^VA(200,"B",MCNAM)) Q:MCNAM="" S MCLNAM=$P(MCNAM,","),MCFNAM=$P(MCNAM,",",2,99) Q:($E(MCLNAM,1,7)'=MC12LNAM) I $E(MCLNAM,1,7)=MC12LNAM,$E(MCFNAM,1,3)=MC12FNAM S MCA(12)=$O(^(MCNAM,0)) Q
51 D KNMK I $D(MCA(12)) Q 0
52 I MCA("DT")>2950430 S MCERR="64-Interpreted By does not match name in New Person file" Q $$LOG^MCARAM7(MCERR)
53 Q $$LOG^MCARAM7("13-Interpreted By does not match name in New Person file")
54 ;
55PROEFF(MCEDT,MCERR) ;Starting May 1, 1995, provider match is required to file record
56 ; if provider does not match, returns fatal error message according
57 ; to test date
58 I MCEDT>2950430 S MCERR="63-Interpreted By is a null data field"
59 K MCEDT Q MCERR
60 ;
61LDHCP(MCA,MCE) ;load local array data into DHCP
62 ; USAGE: S X=$$LDHCP^MCARAM3(.A,.B)
63 ; WHERE: A=local array of data
64 ; B=DHCP data
65 ; including MCE("EKG") =internal record number in EKG file
66 ;transfer local array data into new EKG record in DHCP
67 S MCERR=$$EKG^MCARAM5(.MCA,.MCE) I +MCERR>50 Q $$LOG^MCARAM7(MCERR)
68 ;transfer local array diagnosis data into EKG record
69 S MCERR=$$EKGDG^MCARAM5(.MCA,.MCE) I +MCERR>50 Q $$LOG^MCARAM7(MCERR)
70 ;transfer local array medication data into EKG record
71 S MCERR=$$EKGRX^MCARAM5(.MCA,.MCE) I +MCERR>50 Q $$LOG^MCARAM7(MCERR)
72 ;transfer order and request/consultation data into EKG record
73 S MCERR=$$EKGOR^MCARAM5(.MCA,.MCE) I +MCERR>50 Q $$LOG^MCARAM7(MCERR)
74 Q 0
75 ;
76KNMK ; Kill name check variables
77 K MCNAM,MCFNAM,MCLNAM,MC12NAM,MC12FNAM,MC12LNAM,MCA12 Q
78 ;
79ERR ;Error return
80 Q MCERR
Note: See TracBrowser for help on using the repository browser.