- PXRMCODE ; SLC/PKR - Routines for handling standard coded items. ;06/05/2003
- ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
- ;
- ;==================================================
- VHICD0(DA,X) ;This is the input transform for ICD0 codes subfile 811.22103
- ;high code to make sure it is greater than the low code.
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N VALID
- S VALID=$$VICD0(X)
- I 'VALID Q VALID
- ;Make sure the high code follows the low code.
- N LOW
- S LOW=$P(^PXD(811.2,DA(1),80.1,DA,0),U,1)
- S VALID=$S(X]LOW:1,X=LOW:1,1:0)
- I 'VALID D EN^DDIOL("The high code must be equal to or higher than the low code")
- Q VALID
- ;
- ;==================================================
- VHICD9(DA,X) ;This is the input transform for ICD9 codes subfile 811.22102
- ;high code to make sure it is greater than the low code.
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N VALID
- S VALID=$$VICD9(X)
- I 'VALID Q VALID
- ;Make sure the high code follows the low code.
- N LOW
- S LOW=$P(^PXD(811.2,DA(1),80,DA,0),U,1)
- S VALID=$S(X]LOW:1,X=LOW:1,1:0)
- I 'VALID D EN^DDIOL("The high code must be equal to or higher than the low code")
- Q VALID
- ;
- ;==================================================
- VHICPT(DA,X) ;This is the input transform for ICPT codes subfile 811.22104
- ;high code to make sure it is greater than the low code.
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N VALID
- S VALID=$$VICPT(X)
- I 'VALID Q VALID
- ;Make sure the high code follows the low code.
- N LOW
- S LOW=$P(^PXD(811.2,DA(1),81,DA,0),U,1)
- S VALID=$S(X]LOW:1,X=LOW:1,1:0)
- I 'VALID D EN^DDIOL("The high code must be equal to or higher than the low code")
- Q VALID
- ;
- ;==================================================
- VICD0(X) ;This is the input transform for ICD0 codes, subfile 811.22102.
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N RETVAL,TEMP,TEXT
- S RETVAL=$$CODE^PXRMVAL(X,80.1)
- I '(+RETVAL) D
- . S TEXT=X_"-"_$P(RETVAL,U,4)
- . D EN^DDIOL(TEXT)
- . S TEMP=$P(RETVAL,U,3)
- . S:$P(RETVAL,U,2)=$P(RETVAL,U,3) TEMP=""
- . I TEMP'="" D
- .. S TEXT="(Next code in the file is "_TEMP_")"
- .. D EN^DDIOL(TEXT)
- Q $P(RETVAL,U,1)
- ;
- ;==================================================
- VICD9(X) ;This is the input transform for ICD9 codes subfile 811.22103.
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N RETVAL,TEMP,TEXT
- S RETVAL=$$CODE^PXRMVAL(X,80)
- I '(+RETVAL) D
- . S TEXT=X_"-"_$P(RETVAL,U,4)
- . D EN^DDIOL(TEXT)
- . S TEMP=$P(RETVAL,U,3)
- . S:$P(RETVAL,U,2)=$P(RETVAL,U,3) TEMP=""
- . I TEMP'="" D
- .. S TEXT="(Next code in the file is "_TEMP_")"
- .. D EN^DDIOL(TEXT)
- Q $P(RETVAL,U,1)
- ;
- ;==================================================
- VICPT(X) ;This is the input transform for CPT codes subfile 811.22104.
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N RETVAL,TEMP,TEXT
- S RETVAL=$$CODE^PXRMVAL(X,81)
- I '(+RETVAL) D
- . S TEXT=X_"-"_$P(RETVAL,U,4)
- . D EN^DDIOL(TEXT)
- . S TEMP=$P(RETVAL,U,3)
- . S:$P(RETVAL,U,2)=$P(RETVAL,U,3) TEMP=""
- . I TEMP'="" D
- .. S TEXT="(Next code in the file is "_TEMP_")"
- .. D EN^DDIOL(TEXT)
- Q $P(RETVAL,U,1)
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCODE 3193 printed Jan 18, 2025@02:44:28 Page 2
- PXRMCODE ; SLC/PKR - Routines for handling standard coded items. ;06/05/2003
- +1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
- +2 ;
- +3 ;==================================================
- VHICD0(DA,X) ;This is the input transform for ICD0 codes subfile 811.22103
- +1 ;high code to make sure it is greater than the low code.
- +2 ;Do not execute as part of exchange.
- +3 IF $GET(PXRMEXCH)
- QUIT 1
- +4 NEW VALID
- +5 SET VALID=$$VICD0(X)
- +6 IF 'VALID
- QUIT VALID
- +7 ;Make sure the high code follows the low code.
- +8 NEW LOW
- +9 SET LOW=$PIECE(^PXD(811.2,DA(1),80.1,DA,0),U,1)
- +10 SET VALID=$SELECT(X]LOW:1,X=LOW:1,1:0)
- +11 IF 'VALID
- DO EN^DDIOL("The high code must be equal to or higher than the low code")
- +12 QUIT VALID
- +13 ;
- +14 ;==================================================
- VHICD9(DA,X) ;This is the input transform for ICD9 codes subfile 811.22102
- +1 ;high code to make sure it is greater than the low code.
- +2 ;Do not execute as part of exchange.
- +3 IF $GET(PXRMEXCH)
- QUIT 1
- +4 NEW VALID
- +5 SET VALID=$$VICD9(X)
- +6 IF 'VALID
- QUIT VALID
- +7 ;Make sure the high code follows the low code.
- +8 NEW LOW
- +9 SET LOW=$PIECE(^PXD(811.2,DA(1),80,DA,0),U,1)
- +10 SET VALID=$SELECT(X]LOW:1,X=LOW:1,1:0)
- +11 IF 'VALID
- DO EN^DDIOL("The high code must be equal to or higher than the low code")
- +12 QUIT VALID
- +13 ;
- +14 ;==================================================
- VHICPT(DA,X) ;This is the input transform for ICPT codes subfile 811.22104
- +1 ;high code to make sure it is greater than the low code.
- +2 ;Do not execute as part of exchange.
- +3 IF $GET(PXRMEXCH)
- QUIT 1
- +4 NEW VALID
- +5 SET VALID=$$VICPT(X)
- +6 IF 'VALID
- QUIT VALID
- +7 ;Make sure the high code follows the low code.
- +8 NEW LOW
- +9 SET LOW=$PIECE(^PXD(811.2,DA(1),81,DA,0),U,1)
- +10 SET VALID=$SELECT(X]LOW:1,X=LOW:1,1:0)
- +11 IF 'VALID
- DO EN^DDIOL("The high code must be equal to or higher than the low code")
- +12 QUIT VALID
- +13 ;
- +14 ;==================================================
- VICD0(X) ;This is the input transform for ICD0 codes, subfile 811.22102.
- +1 ;Do not execute as part of exchange.
- +2 IF $GET(PXRMEXCH)
- QUIT 1
- +3 NEW RETVAL,TEMP,TEXT
- +4 SET RETVAL=$$CODE^PXRMVAL(X,80.1)
- +5 IF '(+RETVAL)
- Begin DoDot:1
- +6 SET TEXT=X_"-"_$PIECE(RETVAL,U,4)
- +7 DO EN^DDIOL(TEXT)
- +8 SET TEMP=$PIECE(RETVAL,U,3)
- +9 if $PIECE(RETVAL,U,2)=$PIECE(RETVAL,U,3)
- SET TEMP=""
- +10 IF TEMP'=""
- Begin DoDot:2
- +11 SET TEXT="(Next code in the file is "_TEMP_")"
- +12 DO EN^DDIOL(TEXT)
- End DoDot:2
- End DoDot:1
- +13 QUIT $PIECE(RETVAL,U,1)
- +14 ;
- +15 ;==================================================
- VICD9(X) ;This is the input transform for ICD9 codes subfile 811.22103.
- +1 ;Do not execute as part of exchange.
- +2 IF $GET(PXRMEXCH)
- QUIT 1
- +3 NEW RETVAL,TEMP,TEXT
- +4 SET RETVAL=$$CODE^PXRMVAL(X,80)
- +5 IF '(+RETVAL)
- Begin DoDot:1
- +6 SET TEXT=X_"-"_$PIECE(RETVAL,U,4)
- +7 DO EN^DDIOL(TEXT)
- +8 SET TEMP=$PIECE(RETVAL,U,3)
- +9 if $PIECE(RETVAL,U,2)=$PIECE(RETVAL,U,3)
- SET TEMP=""
- +10 IF TEMP'=""
- Begin DoDot:2
- +11 SET TEXT="(Next code in the file is "_TEMP_")"
- +12 DO EN^DDIOL(TEXT)
- End DoDot:2
- End DoDot:1
- +13 QUIT $PIECE(RETVAL,U,1)
- +14 ;
- +15 ;==================================================
- VICPT(X) ;This is the input transform for CPT codes subfile 811.22104.
- +1 ;Do not execute as part of exchange.
- +2 IF $GET(PXRMEXCH)
- QUIT 1
- +3 NEW RETVAL,TEMP,TEXT
- +4 SET RETVAL=$$CODE^PXRMVAL(X,81)
- +5 IF '(+RETVAL)
- Begin DoDot:1
- +6 SET TEXT=X_"-"_$PIECE(RETVAL,U,4)
- +7 DO EN^DDIOL(TEXT)
- +8 SET TEMP=$PIECE(RETVAL,U,3)
- +9 if $PIECE(RETVAL,U,2)=$PIECE(RETVAL,U,3)
- SET TEMP=""
- +10 IF TEMP'=""
- Begin DoDot:2
- +11 SET TEXT="(Next code in the file is "_TEMP_")"
- +12 DO EN^DDIOL(TEXT)
- End DoDot:2
- End DoDot:1
- +13 QUIT $PIECE(RETVAL,U,1)
- +14 ;