source: FOIAVistA/trunk/r/MEDICINE-MC/MCARAM4.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1MCARAM4 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;5/20/94 15:35
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5 ;Checks format and/or reformats data
6AR(MCA,MCAA,MCD,MCFP,MCLP,MCCK) ;Sets l/t stripped data field into an array
7 ; USAGE: S X=$$AR^MCARAM4(.A,B,C,D,E)
8 ; WHERE: .A = array where data is placed
9 ; B = array argument for data field
10 ; C = data field value
11 ; D = first position of data field
12 ; E = last position of data field
13 ; F = 1 to check numeric data field value for positive int value
14 ; 2 to check "" for both positive and negative int value
15 ; 3 to check "" for pos,neg,int, and decimal values
16 N MCI,MCERR
17 I '$D(MCCK) S MCCK=""
18 S MCA(MCAA)=$E(MCD,MCFP,MCLP),MCI=MCA(MCAA),MCERR=$$SLTS^MCARAM4(.MCI),MCA(MCAA)=MCI I +MCERR>0 Q MCERR
19 I MCCK=1 S MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK) I +MCERR>0 Q MCERR
20 I MCCK=2 S MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK) I +MCERR>0 Q MCERR
21 I MCCK=3 S MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK) I +MCERR>0 Q MCERR
22 Q 0
23 ;
24DFCK(MCV,MCCK) ; Checks numeric,negative,positive,integer,decimal value
25 ; USAGE: S X=$$DFCK^MCARAM4(A,B)
26 ; WHERE: A=data field value
27 ; B=1 for positive value numeric (integer) check
28 ; B=2 for positive and negative value numeric (integer) check
29 ; B=3 for positive, negative, decimal, or integer numeric check
30 ; if successful, returns function value of 0
31 ; if unsuccessful, returns error message for incorrect field format
32 N MCERR
33 I MCV="" S MCERR="2-Null data field" Q MCERR
34 I MCV=0 Q 0
35 I $G(MCCK)=1 I MCV?1N.N Q 0
36 I $G(MCCK)=2 I MCV?."-"1N.N,$P(MCV,"-",2,99)'["-",-MCV+-MCV'=0 Q 0
37 I $G(MCCK)=3 I MCV?."-"."."1N.N.".".N,$P(MCV,".",2,99)'[".",$P(MCV,"-",2,99)'["-",-MCV+-MCV'=0 Q 0
38 S MCERR="1-Data field not numeric" Q MCERR
39 ;
40SLTS(MCV) ; Strips leading and trailing spaces from data fields
41 ; USAGE: S X=$$SLTS^MCARAM4(.A)
42 ; WHERE: MCV=data field value
43 ; .A = value where data is placed
44 ; if successful, returns function value of 0 and data field value
45 ; if unsuccessful, returns error message for incorrect field format
46 N MCERR,MCI,MCJ
47 I MCV="" S MCERR="2-Null data field" Q MCERR
48 F MCI=1:1 I $E(MCV,MCI,MCI)'=" " Q
49 F MCJ=$L(MCV):-1 I $E(MCV,MCJ,MCJ)'=" " Q
50 S MCV=$E(MCV,MCI,MCJ) I MCV="" S MCERR="2-Null data field" Q MCERR
51 Q 0
52 ;
53DGCK(MCA) ;Removes null lines and resets numbering of diagnosis array
54 ; USAGE: S X=$$DGCK^MCARAM4(.A)
55 ; WHERE: MCA=diagnosis array
56 ; .A=diagnosis array renumbered without null lines
57 ; A("DX,0")=total number of non-null diagnosis lines
58 ; if successful, returns function value of 0 and diagnosis array
59 ; if unsuccessful, returns error message and A("DX,0")=0
60 N MCI,MCJ,MCK,MCERR
61 S MCI=0,MCJ="DX,0"
62 F S MCJ=$O(MCA(MCJ)) Q:MCJ=""!($E(MCJ)'=$E("DX,0")) S:MCA(MCJ)'="" MCI=MCI+1 I MCA(MCJ)="" K MCA(MCJ) S MCK=MCJ F S MCK=$O(MCA(MCK)) Q:MCK=""!($E(MCK)'=$E("DX,0")) I MCA(MCK)'="" S MCA(MCJ)=MCA(MCK),MCI=MCI+1,MCA(MCK)="" Q
63 S MCA("DX,0")=MCI I MCI>0 Q 0
64 S MCERR="62-Diagnosis is a null data field" Q MCERR
65 ;
66RXCK(MCA) ;Removes null lines and resets numbering of medication array
67 ; USAGE: S X=$$RXCK^MCARAM4(.A)
68 ; WHERE: MCA=medication array
69 ; .A=medication array renumbered without null lines
70 ; A("RX,0")=total number of non-null medication lines
71 ; if successful, returns function value of 0 and medication array
72 ; if unsuccessful, returns error message and A("RX,0")=0
73 N MCI,MCJ,MCK,MCERR
74 I MCA("RX,0")="" S MCA("RX,0")=0,MCERR="4-Medication is a null data field" Q MCERR
75 F MCJ=1:1 S MCK="RX,"_MCJ,MCA(MCK)=$P(MCA("RX,0"),", ",MCJ) Q:MCA(MCK)="" S MCI=$P(MCA(MCK)," ") I MCI'="",$D(^PSDRUG("B",MCI)) S MCA(MCK)=$O(^(MCI,0))_U_$P(MCA(MCK)," ",2)_U_$P(MCA(MCK)," ",3)
76 K MCA(MCK)
77 S MCA("RX,0")=MCJ-1 I MCJ-1=0 S MCERR="4-Medication is a null data field" Q MCERR
78 Q 0
79 ;
80DGCT(MCA,MCD,MCL) ;Fill diagnosis array from continuation record
81 ; USAGE: S X=$$DGCT^MCARAM4(.A,B,C)
82 ; WHERE: MCA=diagnosis array
83 ; .A=diagnosis array renumbered without null lines
84 ; B=data field value, C=line number of data
85 ; A("DX,0")=total number of non-null diagnosis lines
86 ; "DX,L"=12th line of diagnosis, "DX,V"=22nd line
87 ; if successful, returns function value of 0 and diagnosis array
88 ; if unsuccessful, returns error message and A("DX,0")=0
89 N MCI,MCERR
90 S MCI="DX,"_MCA("CONT")
91 I MCL=13!(MCL=25) S MCERR=$$AR^MCARAM4(.MCA,MCI,MCD,32,78) Q:+MCERR>0 MCERR Q 0
92 S MCERR=$$AR^MCARAM4(.MCA,MCI,MCD,32,134) Q:+MCERR>0 MCERR
93 Q 0
94 ;
95ERR ;Error return
96 Q MCERR
Note: See TracBrowser for help on using the repository browser.