| 1 | PXRMCODE ; SLC/PKR - Routines for handling standard coded items. ;06/05/2003
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | ;==================================================
|
|---|
| 5 | VHICD0(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 | ;==================================================
|
|---|
| 20 | VHICD9(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 | ;==================================================
|
|---|
| 35 | VHICPT(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 | ;==================================================
|
|---|
| 50 | VICD0(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 | ;==================================================
|
|---|
| 66 | VICD9(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 | ;==================================================
|
|---|
| 82 | VICPT(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 | ;
|
|---|
