source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCODE.m@ 1040

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1PXRMCODE ; SLC/PKR - Routines for handling standard coded items. ;06/05/2003
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;==================================================
5VHICD0(DA,X) ;This is the input transform for ICD0 codes subfile 811.22103
6 ;high code to make sure it is greater than the low code.
7 ;Do not execute as part of exchange.
8 I $G(PXRMEXCH) Q 1
9 N VALID
10 S VALID=$$VICD0(X)
11 I 'VALID Q VALID
12 ;Make sure the high code follows the low code.
13 N LOW
14 S LOW=$P(^PXD(811.2,DA(1),80.1,DA,0),U,1)
15 S VALID=$S(X]LOW:1,X=LOW:1,1:0)
16 I 'VALID D EN^DDIOL("The high code must be equal to or higher than the low code")
17 Q VALID
18 ;
19 ;==================================================
20VHICD9(DA,X) ;This is the input transform for ICD9 codes subfile 811.22102
21 ;high code to make sure it is greater than the low code.
22 ;Do not execute as part of exchange.
23 I $G(PXRMEXCH) Q 1
24 N VALID
25 S VALID=$$VICD9(X)
26 I 'VALID Q VALID
27 ;Make sure the high code follows the low code.
28 N LOW
29 S LOW=$P(^PXD(811.2,DA(1),80,DA,0),U,1)
30 S VALID=$S(X]LOW:1,X=LOW:1,1:0)
31 I 'VALID D EN^DDIOL("The high code must be equal to or higher than the low code")
32 Q VALID
33 ;
34 ;==================================================
35VHICPT(DA,X) ;This is the input transform for ICPT codes subfile 811.22104
36 ;high code to make sure it is greater than the low code.
37 ;Do not execute as part of exchange.
38 I $G(PXRMEXCH) Q 1
39 N VALID
40 S VALID=$$VICPT(X)
41 I 'VALID Q VALID
42 ;Make sure the high code follows the low code.
43 N LOW
44 S LOW=$P(^PXD(811.2,DA(1),81,DA,0),U,1)
45 S VALID=$S(X]LOW:1,X=LOW:1,1:0)
46 I 'VALID D EN^DDIOL("The high code must be equal to or higher than the low code")
47 Q VALID
48 ;
49 ;==================================================
50VICD0(X) ;This is the input transform for ICD0 codes, subfile 811.22102.
51 ;Do not execute as part of exchange.
52 I $G(PXRMEXCH) Q 1
53 N RETVAL,TEMP,TEXT
54 S RETVAL=$$CODE^PXRMVAL(X,80.1)
55 I '(+RETVAL) D
56 . S TEXT=X_"-"_$P(RETVAL,U,4)
57 . D EN^DDIOL(TEXT)
58 . S TEMP=$P(RETVAL,U,3)
59 . S:$P(RETVAL,U,2)=$P(RETVAL,U,3) TEMP=""
60 . I TEMP'="" D
61 .. S TEXT="(Next code in the file is "_TEMP_")"
62 .. D EN^DDIOL(TEXT)
63 Q $P(RETVAL,U,1)
64 ;
65 ;==================================================
66VICD9(X) ;This is the input transform for ICD9 codes subfile 811.22103.
67 ;Do not execute as part of exchange.
68 I $G(PXRMEXCH) Q 1
69 N RETVAL,TEMP,TEXT
70 S RETVAL=$$CODE^PXRMVAL(X,80)
71 I '(+RETVAL) D
72 . S TEXT=X_"-"_$P(RETVAL,U,4)
73 . D EN^DDIOL(TEXT)
74 . S TEMP=$P(RETVAL,U,3)
75 . S:$P(RETVAL,U,2)=$P(RETVAL,U,3) TEMP=""
76 . I TEMP'="" D
77 .. S TEXT="(Next code in the file is "_TEMP_")"
78 .. D EN^DDIOL(TEXT)
79 Q $P(RETVAL,U,1)
80 ;
81 ;==================================================
82VICPT(X) ;This is the input transform for CPT codes subfile 811.22104.
83 ;Do not execute as part of exchange.
84 I $G(PXRMEXCH) Q 1
85 N RETVAL,TEMP,TEXT
86 S RETVAL=$$CODE^PXRMVAL(X,81)
87 I '(+RETVAL) D
88 . S TEXT=X_"-"_$P(RETVAL,U,4)
89 . D EN^DDIOL(TEXT)
90 . S TEMP=$P(RETVAL,U,3)
91 . S:$P(RETVAL,U,2)=$P(RETVAL,U,3) TEMP=""
92 . I TEMP'="" D
93 .. S TEXT="(Next code in the file is "_TEMP_")"
94 .. D EN^DDIOL(TEXT)
95 Q $P(RETVAL,U,1)
96 ;
Note: See TracBrowser for help on using the repository browser.