- ICPTMOD2 ;ALB/DEK/KER - CPT MODIFIER APIS ;08/18/2007
- ;;6.0;CPT/HCPCS;**30,37**;May 19, 1997;Build 25
- ;
- ; Global Variables
- ; ^DIC(81.3
- ; ^ICPT(
- ;
- ; External References
- ; $$DT^XLFDT DBIA 10103
- ; $$FMADD^XLFDT DBIA 10103
- ;
- Q
- MODA ; Create an array of Modifiers for a CPT Code
- ;
- ; Input
- ;
- ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
- ; VDT Versioning Date (date service provided)
- ; .ARY Name of a Local Array passed by value
- ;
- ; Output
- ;
- ; ARY Only returns Active Modifiers
- ; ARY(0) = 4 Piece String
- ; 4 Piece String
- ; 1 # of Modifiers found for code CODE (input)
- ; 2 # of Modifiers w/Active Ranges
- ; 3 # of Modifiers w/Inactive Ranges
- ; 4 Code
- ;
- ; ARY(ST,MOD) = 8 Piece Output String
- ;
- ; ST Status A=Active I=Inactive
- ; MOD Modifier (external format)
- ; 8 Piece String
- ; 1 IEN of Modifier
- ; 2 Versioned Short Text (name)
- ; 3 Activation date of Modifier
- ; 4 Beginning Range Code
- ; 5 Ending Range Code
- ; 6 Activation Date of Range
- ; 7 Inactivation Date of Range
- ; 8 Modifier Identifier
- ;
- N A,EFF,I,ID,MIEN,MOD,SRC,ST,X K ARY
- S CODE=$G(CODE) Q:'$D(^ICPT("BA",(CODE_" ")))
- S VDT=$G(VDT) S:+VDT'>0 VDT=$$DT^XLFDT Q:VDT'?7N
- S SRC=3,MIEN=0 F S MIEN=$O(^DIC(81.3,MIEN)) Q:+MIEN'>0 D
- . S (EFF,ST)=$O(^DIC(81.3,MIEN,60,"B"," "),-1) Q:ST'>0 S ST=$O(^DIC(81.3,MIEN,60,"B",ST," "),-1) Q:ST'>0 S ST=$P($G(^DIC(81.3,MIEN,60,ST,0)),"^",2) Q:ST'>0
- . S MOD=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MOD)
- . S X=$$MODP(CODE,MIEN,"I",VDT,0) S ID=$P(X,"^",6) S ID=$S(+ID>0:"I",1:"A")
- . S:+X>0 ARY(ID,MOD)=$P(X,"^",1,2)_"^"_EFF_"^"_$P(X,"^",3,7)
- S (A,I)=0,ST="" F S ST=$O(ARY(ST)) Q:ST="" S MOD="" F S MOD=$O(ARY(ST,MOD)) Q:MOD="" S:ST="A" A=A+1 S:ST="I" I=I+1
- S ST=A+I,ARY(0)=ST_"^"_A_"^"_I_"^"_CODE
- Q
- ;
- MODP(CODE,MOD,MFT,MDT,SRC,DFN) ; Check if modifier can be used with code (pair)
- ;
- ; Input:
- ;
- ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
- ; MOD Modifier (External or Internal)
- ; MFT Modifier Format "E" - or "I"
- ; VDT Date service provided
- ; SRC Source Screen
- ; If 0 or Null, Level I and II modifiers
- ; If >0, Level I, II, and III modifiers
- ; Output:
- ;
- ; If pair is acceptable - Positive "^" Delimited String
- ;
- ; 1 - IEN of CPT Modifier
- ; 2 - Versioned Short Text
- ; 3 - Beginning Code for Code Range
- ; 4 - Ending Code for Code Range
- ; 5 - Code Range Activaiton Date
- ; 6 - Code Range Inactivation Date
- ; 7 - Modifier Identifier
- ;
- ; If pair is unacceptable
- ;
- ; 0 or
- ; -1 with error message
- ;
- N ADT,BEGA,BEGR,CDT,CODEA,CODN,ENDA,ENDR,ICD,IDT,LACT,LINA,MIEN,MODEFF,MODI,MODNM,MODST,ND,NSTA,RIEN,RSTA,SIEN,STA,STI,STX,TA,TEFF,TI,TIEN,VDT
- S:$G(MFT)="" MFT="E" Q:"^E^I^"'[("^"_MFT_"^") "-1^Invalid Modifier Format" S VDT=$P($G(MDT),".",1)
- S:+VDT'?7N VDT=$$DT^XLFDT S:VDT#10000=0 VDT=VDT+101 S:VDT#100=0 VDT=VDT+1 S VDT=$S(VDT<2890101:2890101,1:VDT)
- Q:+VDT'>0!(VDT'?7N) "-1^Invalid Date" I MFT="E" D I +($G(MIEN))'>0 Q "-1^Multiple Modifiers with the same name, use IEN"
- . S MIEN=0 S (TIEN,TI)=0 F S TIEN=$O(^DIC(81.3,"B",MOD,TIEN)) Q:+TIEN'>0 D
- . . S TEFF=$$EFF^ICPTSUPT(81.3,TIEN,VDT) Q:'$P(TEFF,"^",2) S TI=TI+1,TA(TI)=TIEN,TA(0)=TI
- . S:+($G(TA(0)))=1 MIEN=+($G(TA(1)))
- S:MFT="I" MIEN=+MOD S CODE=$G(CODE),CODN=$S(CODE?1.N:+CODE,1:$$CODEN^ICPTCOD(CODE)) I CODN<1!'$D(^ICPT(CODN,0)) Q "-1^NO SUCH CPT CODE"
- S CODE=$P($G(^ICPT(CODN,0)),"^") Q:'$L(CODE) "-1^No such CPT Code" Q:$L(CODE)'=5 "-1^Invalid Code"
- S CODEA=$S(CODE?1N.4N:+CODE,CODE?4N1A:$A($E(CODE,5))*10_$E(CODE,1,4),1:$A(CODE)_$E(CODE,2,5)) Q:+CODEA'>0 "-1^Invalid Code Source"
- S MIEN=$G(MIEN) Q:+MIEN'>0 "-1^Invalid Modifier" S SRC=$S(+($G(SRC))>0:1,1:0),SIEN=$O(^ICPT("BA",(CODE_" "),0)) Q:+SIEN'>0 "-3^Invalid Code"
- Q:$P($G(^ICPT(+SIEN,0)),"^",6)="L"&(SRC'>0) "-1^Invalid Code Source"
- S MODEFF=$$EFF^ICPTSUPT(81.3,MIEN,VDT) Q:'$P(MODEFF,"^",2) "-1^Modifier Inactive"
- S MODNM=$P($G(^DIC(81.3,MIEN,0)),"^",2) Q:'$L(MODNM) "-1^Invalid Modifier Name"
- S MODI=$P($G(^DIC(81.3,MIEN,0)),"^",1) Q:'$L(MODI) "-1^Invalid Modifier ID"
- S MODST=$$VSTCM^ICPTMOD(MIEN,VDT) K STX S (STA,STI)=0 S CDT=VDT+.001
- S (LINA,LACT)="",RSTA=0,RIEN=0 F S RIEN=$O(^DIC(81.3,MIEN,10,RIEN)) Q:+RIEN'>0 D
- . N NSTA S NSTA=0,ND=$G(^DIC(81.3,MIEN,10,RIEN,0))
- . S BEGR=$P(ND,"^",1) Q:$L(BEGR)'=5 S BEGA=$S(BEGR?1N.4N:+BEGR,BEGR?4N1A:$A($E(BEGR,5))*10_$E(BEGR,1,4),1:$A(BEGR)_$E(BEGR,2,5)) Q:+CODEA<+BEGA
- . S ENDR=$P(ND,"^",2) S:$L(ENDR)'=5 ENDR=BEGR S ENDA=$S(ENDR?1N.4N:+ENDR,ENDR?4N1A:$A($E(ENDR,5))*10_$E(ENDR,1,4),1:$A(ENDR)_$E(ENDR,2,5))
- . Q:$L(ENDR)&(CODEA>ENDA) S ADT=$P(ND,"^",3),(ICD,IDT)=$P(ND,"^",4) S:ADT="" ADT=2890101
- . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT'>0 S RSTA=1,NSTA=1 S:+ADT>0&(+ADT>(+LACT)) LACT=+ADT
- . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT>0,CDT>ADT,CDT'>IDT S RSTA=1,NSTA=1 S:+ADT>0&(+ADT>(+LACT)) LACT=+ADT
- . I +CODEA'<+BEGA,+CODEA'>ENDA,+ADT>0,+IDT>0 S:+IDT>0&(+IDT>(+LINA)) LINA=+IDT
- . Q:NSTA'>0 S:'$L(IDT) IDT=$$FMADD^XLFDT($$DT^XLFDT,365) S ADT=$P(ND,"^",3),(ICD,IDT)=$P(ND,"^",4) S:ADT="" ADT=2890101
- . S:'$L(IDT) IDT=$$FMADD^XLFDT($$DT^XLFDT,365) S STA=+($G(STA))+1,STX(STA)=MIEN_"^"_MODST_"^"_BEGR_"^"_ENDR_"^"_ADT_"^"_ICD_"^"_MODI,STX("B",+ADT,+STA)=""
- S:+LACT>0&(+LINA>0)&(LINA'>CDT)&(+LINA>+LACT) RSTA=0
- S ADT=$O(STX("B",+CDT),-1),STA=$O(STX("B",+ADT," "),-1),MOD=$G(STX(+STA))
- Q:+MOD'>0 "0" Q:+RSTA'>0 "0"
- Q MOD
- ;
- MODC(MOD) ; Checks modifier for active range including code
- ;
- ; Input:
- ; MOD - modifier ien
- ;
- N MODNM,MODEFF
- S MODEFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
- I '$P(MODEFF,"^",2) S STR="-1^modifier inactive" Q
- S PR=CODEA_.0001,PR=$O(^DIC(81.3,MOD,"M",PR),-1)
- I 'PR S STR=0 Q
- S PRN=^DIC(81.3,MOD,"M",PR)
- I 'PRN S STR="-1^bad modifier file entry" Q
- I PRN<CODEA S STR=0 Q
- S MODNM=$P($G(^DIC(81.3,MOD,0)),"^",2)
- S STR=MOD_"^"_MODNM
- Q
- ;
- MULT ; Finds iens for all modifiers with same 2-letter code
- ; MOD = .01, check B x-ref for dupliate .01 fields
- ; Output:
- ; STR - a ";" delimited string of IENS for modifier MOD
- F MODN=0:0 S MODN=$O(^DIC(81.3,"B",MOD,MODN)) Q:'MODN S STR=STR_MODN_"; "
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPTMOD2 6618 printed Jan 18, 2025@02:47 Page 2
- ICPTMOD2 ;ALB/DEK/KER - CPT MODIFIER APIS ;08/18/2007
- +1 ;;6.0;CPT/HCPCS;**30,37**;May 19, 1997;Build 25
- +2 ;
- +3 ; Global Variables
- +4 ; ^DIC(81.3
- +5 ; ^ICPT(
- +6 ;
- +7 ; External References
- +8 ; $$DT^XLFDT DBIA 10103
- +9 ; $$FMADD^XLFDT DBIA 10103
- +10 ;
- +11 QUIT
- MODA ; Create an array of Modifiers for a CPT Code
- +1 ;
- +2 ; Input
- +3 ;
- +4 ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
- +5 ; VDT Versioning Date (date service provided)
- +6 ; .ARY Name of a Local Array passed by value
- +7 ;
- +8 ; Output
- +9 ;
- +10 ; ARY Only returns Active Modifiers
- +11 ; ARY(0) = 4 Piece String
- +12 ; 4 Piece String
- +13 ; 1 # of Modifiers found for code CODE (input)
- +14 ; 2 # of Modifiers w/Active Ranges
- +15 ; 3 # of Modifiers w/Inactive Ranges
- +16 ; 4 Code
- +17 ;
- +18 ; ARY(ST,MOD) = 8 Piece Output String
- +19 ;
- +20 ; ST Status A=Active I=Inactive
- +21 ; MOD Modifier (external format)
- +22 ; 8 Piece String
- +23 ; 1 IEN of Modifier
- +24 ; 2 Versioned Short Text (name)
- +25 ; 3 Activation date of Modifier
- +26 ; 4 Beginning Range Code
- +27 ; 5 Ending Range Code
- +28 ; 6 Activation Date of Range
- +29 ; 7 Inactivation Date of Range
- +30 ; 8 Modifier Identifier
- +31 ;
- +32 NEW A,EFF,I,ID,MIEN,MOD,SRC,ST,X
- KILL ARY
- +33 SET CODE=$GET(CODE)
- if '$DATA(^ICPT("BA",(CODE_" ")))
- QUIT
- +34 SET VDT=$GET(VDT)
- if +VDT'>0
- SET VDT=$$DT^XLFDT
- if VDT'?7N
- QUIT
- +35 SET SRC=3
- SET MIEN=0
- FOR
- SET MIEN=$ORDER(^DIC(81.3,MIEN))
- if +MIEN'>0
- QUIT
- Begin DoDot:1
- +36 SET (EFF,ST)=$ORDER(^DIC(81.3,MIEN,60,"B"," "),-1)
- if ST'>0
- QUIT
- SET ST=$ORDER(^DIC(81.3,MIEN,60,"B",ST," "),-1)
- if ST'>0
- QUIT
- SET ST=$PIECE($GET(^DIC(81.3,MIEN,60,ST,0)),"^",2)
- if ST'>0
- QUIT
- +37 SET MOD=$PIECE($GET(^DIC(81.3,MIEN,0)),"^",1)
- if '$LENGTH(MOD)
- QUIT
- +38 SET X=$$MODP(CODE,MIEN,"I",VDT,0)
- SET ID=$PIECE(X,"^",6)
- SET ID=$SELECT(+ID>0:"I",1:"A")
- +39 if +X>0
- SET ARY(ID,MOD)=$PIECE(X,"^",1,2)_"^"_EFF_"^"_$PIECE(X,"^",3,7)
- End DoDot:1
- +40 SET (A,I)=0
- SET ST=""
- FOR
- SET ST=$ORDER(ARY(ST))
- if ST=""
- QUIT
- SET MOD=""
- FOR
- SET MOD=$ORDER(ARY(ST,MOD))
- if MOD=""
- QUIT
- if ST="A"
- SET A=A+1
- if ST="I"
- SET I=I+1
- +41 SET ST=A+I
- SET ARY(0)=ST_"^"_A_"^"_I_"^"_CODE
- +42 QUIT
- +43 ;
- MODP(CODE,MOD,MFT,MDT,SRC,DFN) ; Check if modifier can be used with code (pair)
- +1 ;
- +2 ; Input:
- +3 ;
- +4 ; CODE CPT/HCPCS Code ?7N / ?1A4N / ?4N1A
- +5 ; MOD Modifier (External or Internal)
- +6 ; MFT Modifier Format "E" - or "I"
- +7 ; VDT Date service provided
- +8 ; SRC Source Screen
- +9 ; If 0 or Null, Level I and II modifiers
- +10 ; If >0, Level I, II, and III modifiers
- +11 ; Output:
- +12 ;
- +13 ; If pair is acceptable - Positive "^" Delimited String
- +14 ;
- +15 ; 1 - IEN of CPT Modifier
- +16 ; 2 - Versioned Short Text
- +17 ; 3 - Beginning Code for Code Range
- +18 ; 4 - Ending Code for Code Range
- +19 ; 5 - Code Range Activaiton Date
- +20 ; 6 - Code Range Inactivation Date
- +21 ; 7 - Modifier Identifier
- +22 ;
- +23 ; If pair is unacceptable
- +24 ;
- +25 ; 0 or
- +26 ; -1 with error message
- +27 ;
- +28 NEW ADT,BEGA,BEGR,CDT,CODEA,CODN,ENDA,ENDR,ICD,IDT,LACT,LINA,MIEN,MODEFF,MODI,MODNM,MODST,ND,NSTA,RIEN,RSTA,SIEN,STA,STI,STX,TA,TEFF,TI,TIEN,VDT
- +29 if $GET(MFT)=""
- SET MFT="E"
- if "^E^I^"'[("^"_MFT_"^")
- QUIT "-1^Invalid Modifier Format"
- SET VDT=$PIECE($GET(MDT),".",1)
- +30 if +VDT'?7N
- SET VDT=$$DT^XLFDT
- if VDT#10000=0
- SET VDT=VDT+101
- if VDT#100=0
- SET VDT=VDT+1
- SET VDT=$SELECT(VDT<2890101:2890101,1:VDT)
- +31 if +VDT'>0!(VDT'?7N)
- QUIT "-1^Invalid Date"
- IF MFT="E"
- Begin DoDot:1
- +32 SET MIEN=0
- SET (TIEN,TI)=0
- FOR
- SET TIEN=$ORDER(^DIC(81.3,"B",MOD,TIEN))
- if +TIEN'>0
- QUIT
- Begin DoDot:2
- +33 SET TEFF=$$EFF^ICPTSUPT(81.3,TIEN,VDT)
- if '$PIECE(TEFF,"^",2)
- QUIT
- SET TI=TI+1
- SET TA(TI)=TIEN
- SET TA(0)=TI
- End DoDot:2
- +34 if +($GET(TA(0)))=1
- SET MIEN=+($GET(TA(1)))
- End DoDot:1
- IF +($GET(MIEN))'>0
- QUIT "-1^Multiple Modifiers with the same name, use IEN"
- +35 if MFT="I"
- SET MIEN=+MOD
- SET CODE=$GET(CODE)
- SET CODN=$SELECT(CODE?1.N:+CODE,1:$$CODEN^ICPTCOD(CODE))
- IF CODN<1!'$DATA(^ICPT(CODN,0))
- QUIT "-1^NO SUCH CPT CODE"
- +36 SET CODE=$PIECE($GET(^ICPT(CODN,0)),"^")
- if '$LENGTH(CODE)
- QUIT "-1^No such CPT Code"
- if $LENGTH(CODE)'=5
- QUIT "-1^Invalid Code"
- +37 SET CODEA=$SELECT(CODE?1N.4N:+CODE,CODE?4N1A:$ASCII($EXTRACT(CODE,5))*10_$EXTRACT(CODE,1,4),1:$ASCII(CODE)_$EXTRACT(CODE,2,5))
- if +CODEA'>0
- QUIT "-1^Invalid Code Source"
- +38 SET MIEN=$GET(MIEN)
- if +MIEN'>0
- QUIT "-1^Invalid Modifier"
- SET SRC=$SELECT(+($GET(SRC))>0:1,1:0)
- SET SIEN=$ORDER(^ICPT("BA",(CODE_" "),0))
- if +SIEN'>0
- QUIT "-3^Invalid Code"
- +39 if $PIECE($GET(^ICPT(+SIEN,0)),"^",6)="L"&(SRC'>0)
- QUIT "-1^Invalid Code Source"
- +40 SET MODEFF=$$EFF^ICPTSUPT(81.3,MIEN,VDT)
- if '$PIECE(MODEFF,"^",2)
- QUIT "-1^Modifier Inactive"
- +41 SET MODNM=$PIECE($GET(^DIC(81.3,MIEN,0)),"^",2)
- if '$LENGTH(MODNM)
- QUIT "-1^Invalid Modifier Name"
- +42 SET MODI=$PIECE($GET(^DIC(81.3,MIEN,0)),"^",1)
- if '$LENGTH(MODI)
- QUIT "-1^Invalid Modifier ID"
- +43 SET MODST=$$VSTCM^ICPTMOD(MIEN,VDT)
- KILL STX
- SET (STA,STI)=0
- SET CDT=VDT+.001
- +44 SET (LINA,LACT)=""
- SET RSTA=0
- SET RIEN=0
- FOR
- SET RIEN=$ORDER(^DIC(81.3,MIEN,10,RIEN))
- if +RIEN'>0
- QUIT
- Begin DoDot:1
- +45 NEW NSTA
- SET NSTA=0
- SET ND=$GET(^DIC(81.3,MIEN,10,RIEN,0))
- +46 SET BEGR=$PIECE(ND,"^",1)
- if $LENGTH(BEGR)'=5
- QUIT
- SET BEGA=$SELECT(BEGR?1N.4N:+BEGR,BEGR?4N1A:$ASCII($EXTRACT(BEGR,5))*10_$EXTRACT(BEGR,1,4),1:$ASCII(BEGR)_$EXTRACT(BEGR,2,5))
- if +CODEA<+BEGA
- QUIT
- +47 SET ENDR=$PIECE(ND,"^",2)
- if $LENGTH(ENDR)'=5
- SET ENDR=BEGR
- SET ENDA=$SELECT(ENDR?1N.4N:+ENDR,ENDR?4N1A:$ASCII($EXTRACT(ENDR,5))*10_$EXTRACT(ENDR,1,4),1:$ASCII(ENDR)_$EXTRACT(ENDR,2,5))
- +48 if $LENGTH(ENDR)&(CODEA>ENDA)
- QUIT
- SET ADT=$PIECE(ND,"^",3)
- SET (ICD,IDT)=$PIECE(ND,"^",4)
- if ADT=""
- SET ADT=2890101
- +49 IF +CODEA'<+BEGA
- IF +CODEA'>ENDA
- IF +ADT>0
- IF +IDT'>0
- SET RSTA=1
- SET NSTA=1
- if +ADT>0&(+ADT>(+LACT))
- SET LACT=+ADT
- +50 IF +CODEA'<+BEGA
- IF +CODEA'>ENDA
- IF +ADT>0
- IF +IDT>0
- IF CDT>ADT
- IF CDT'>IDT
- SET RSTA=1
- SET NSTA=1
- if +ADT>0&(+ADT>(+LACT))
- SET LACT=+ADT
- +51 IF +CODEA'<+BEGA
- IF +CODEA'>ENDA
- IF +ADT>0
- IF +IDT>0
- if +IDT>0&(+IDT>(+LINA))
- SET LINA=+IDT
- +52 if NSTA'>0
- QUIT
- if '$LENGTH(IDT)
- SET IDT=$$FMADD^XLFDT($$DT^XLFDT,365)
- SET ADT=$PIECE(ND,"^",3)
- SET (ICD,IDT)=$PIECE(ND,"^",4)
- if ADT=""
- SET ADT=2890101
- +53 if '$LENGTH(IDT)
- SET IDT=$$FMADD^XLFDT($$DT^XLFDT,365)
- SET STA=+($GET(STA))+1
- SET STX(STA)=MIEN_"^"_MODST_"^"_BEGR_"^"_ENDR_"^"_ADT_"^"_ICD_"^"_MODI
- SET STX("B",+ADT,+STA)=""
- End DoDot:1
- +54 if +LACT>0&(+LINA>0)&(LINA'>CDT)&(+LINA>+LACT)
- SET RSTA=0
- +55 SET ADT=$ORDER(STX("B",+CDT),-1)
- SET STA=$ORDER(STX("B",+ADT," "),-1)
- SET MOD=$GET(STX(+STA))
- +56 if +MOD'>0
- QUIT "0"
- if +RSTA'>0
- QUIT "0"
- +57 QUIT MOD
- +58 ;
- MODC(MOD) ; Checks modifier for active range including code
- +1 ;
- +2 ; Input:
- +3 ; MOD - modifier ien
- +4 ;
- +5 NEW MODNM,MODEFF
- +6 SET MODEFF=$$EFF^ICPTSUPT(81.3,MOD,MDT)
- +7 IF '$PIECE(MODEFF,"^",2)
- SET STR="-1^modifier inactive"
- QUIT
- +8 SET PR=CODEA_.0001
- SET PR=$ORDER(^DIC(81.3,MOD,"M",PR),-1)
- +9 IF 'PR
- SET STR=0
- QUIT
- +10 SET PRN=^DIC(81.3,MOD,"M",PR)
- +11 IF 'PRN
- SET STR="-1^bad modifier file entry"
- QUIT
- +12 IF PRN<CODEA
- SET STR=0
- QUIT
- +13 SET MODNM=$PIECE($GET(^DIC(81.3,MOD,0)),"^",2)
- +14 SET STR=MOD_"^"_MODNM
- +15 QUIT
- +16 ;
- MULT ; Finds iens for all modifiers with same 2-letter code
- +1 ; MOD = .01, check B x-ref for dupliate .01 fields
- +2 ; Output:
- +3 ; STR - a ";" delimited string of IENS for modifier MOD
- +4 FOR MODN=0:0
- SET MODN=$ORDER(^DIC(81.3,"B",MOD,MODN))
- if 'MODN
- QUIT
- SET STR=STR_MODN_"; "
- +5 QUIT