SROMOD ;BIR/ADM - CPT Modifier Input ; [ 02/27/01 6:32 AM ]
;;3.0;Surgery;**88,100,127,165,187**;24 Jun 93;Build 4
Q
DISPLAY ; display name with modifier
N SRY,SRDA,SRDATE S SRDATE=DT
S SRDA=$S($G(SRTN):SRTN,$D(DA(1)):DA(1),$D(DA):DA,1:"")
I $G(SRDA) S SRDATE=$P($G(^SRF(SRDA,0)),"^",9)
S SRY=$$MOD^ICPTMOD(Y,"I",SRDATE) Q:$P(SRY,"^")=-1
S Y=$P(SRY,"^",2)_" "_$P(SRY,"^",3)
Q
SCR27() ; screen for acceptable CPT code/modifier pair for principal procedure
N SRCODE,SRDA,SRCMOD,SROK,SRSDATE,SRZ D PCHK K SRM
Q SROK
PCHK ; return value of modifier if acceptable for principal procedure
N SRSDATE S SRSDATE=DT K ICPTVDT
S SROK=0,SRCODE="",SRDA=$S($G(SRTN):SRTN,$D(DA(1)):DA(1),$D(DA):DA,1:""),SRM=$S($D(SRM):SRM,1:+Y)
I SRDA S SRSDATE=$P(^SRF(SRDA,0),"^",9),SRCODE=$P($G(^SRF(SRDA,"OP")),"^",2)
;;Begin *165 - RJS
I 'SRCODE!($G(X)=51) Q
;; End *165 - RJS
S SRZ=$P($$MODP^ICPTMOD(SRCODE,SRM,"I",SRSDATE),"^") I SRZ>0 S SROK=SRZ
I SROK,$D(^DIC(81.3,SROK,0)),$P(^(0),U)=51 S (SROK,SRZ)=0
S ICPTVDT=SRSDATE
Q
OTH() ; screen for acceptable CPT code/modifier pair for other procedure
N SRCODE,SRDA,SRCMOD,SROK,SROTH,SRSDATE,SRZ D OCHK K SRM
Q SROK
OCHK ; return value of modifier if acceptable for other procedure
N SRSDATE S SRSDATE=DT K ICPTVDT
S SROK=0,SRCODE="",SRDA=$S($G(SRTN):SRTN,$D(DA(2)):DA(2),$D(DA(1)):DA(1),$D(D0):D0,1:""),SROTH=$S($D(DA):DA,$D(D1):D1,1:""),SRM=$S($D(SRM):SRM,1:+Y)
I SRDA&SROTH S SRSDATE=$P(^SRF(SRDA,0),"^",9),SRCODE=$P($G(^SRF(SRDA,13,SROTH,2)),"^")
I 'SRCODE Q
S SRZ=$P($$MODP^ICPTMOD(SRCODE,SRM,"I",SRSDATE),"^") I SRZ>0 S SROK=SRZ
S ICPTVDT=SRSDATE
Q
SPRIN ; set logic for ACPT x-ref
Q:$E($G(IOST))'="C"!($G(DIK)'="")
N SRCODE,SRDA,SRDEF,SRIEN,SRJ,SRQ,SRSDATE,SRSEL,SRSOUT,SRX,SRY,Z S (SRQ,SRSOUT)=0,SRCODE=X N X I $D(SRCMOD) D HYPH27
S SRDA=DA,SRIEN=$O(^SRF(SRDA,"OPMOD","AAA"),-1) I SRIEN S SRX=$P(^SRF(SRDA,"OPMOD",SRIEN,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRX,"I"),"^",2)
K DIR F D K SRM,SRCMOD Q:SRSOUT S SRQ=0
.S DIR("A")=" Modifier: ",DIR(0)="130.028,.01AO" S:$G(SRCMOD)'="" DIR("B")=SRCMOD D:$O(^SRF(SRDA,"OPMOD",0)) QUES
.D ^DIR K DIR S DA=SRDA I $D(DTOUT)!$D(DUOUT)!(X="") S SRSOUT=1 Q
.I +Y S SRJ=0 F S SRJ=$O(^SRF(SRDA,"OPMOD",SRJ)) Q:'SRJ I $P(^SRF(SRDA,"OPMOD",SRJ,0),"^")=+Y N DIR D Q
..S SRSEL=Y(0),DIR(0)="130.028,.01AO",DIR("A")=" Modifier: ",DIR("B")=$P(Y(0),"^")
..D ^DIR S DA=SRDA I $D(DTOUT)!$D(DUOUT)!(X="") S SRSOUT=1 Q
..I +Y S SRK=0 F S SRK=$O(^SRF(SRDA,"OPMOD",SRK)) Q:'SRK I $P(^SRF(SRDA,"OPMOD",SRK,0),"^")=+Y S SRQ=1 Q
..Q:SRQ I +Y S $P(^SRF(SRDA,"OPMOD",SRJ,0),"^")=+Y,SRQ=1 Q
..I X="@" S SRY(130.028,SRJ_","_SRDA_",",.01)="@" D FILE^DIE("","SRY"),EN^DDIOL(" ... Modifier deleted","","?20") S SRQ=1
.Q:SRQ!SRSOUT
.I +Y S SRY(130.028,"+1,"_DA_",",.01)=+Y D UPDATE^DIE("","SRY") Q
.I X="@",$D(SRCMOD) S SRY(130.028,SRIEN_","_SRDA_",",.01)="@" D FILE^DIE("","SRY"),EN^DDIOL(" ... Modifier deleted","","?20")
Q
KPRIN ; kill logic for ACPT x-ref
Q:$E($G(IOST))'="C"!($G(DIK)'="") K ^SRF(DA,"OPMOD")
Q
SOTH ; set logic for ACPT1 x-ref
Q:$E($G(IOST))'="C"!($G(DIK)'="")
N SRCODE,SRDA,SRDEF,SRIEN,SRJ,SRQ,SRSDATE,SRSEL,SRSOUT,SRX,SRY,Z S (SRQ,SRSOUT)=0,SRCODE=X N X I $D(SRCMOD) D HYPHOTH
S SRDA=DA,SRDA(1)=DA(1),SRIEN=$O(^SRF(SRDA(1),13,SRDA,"MOD","A"),-1) I SRIEN S SRX=$P(^SRF(SRDA(1),13,SRDA,"MOD",SRIEN,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRX,"I"),"^",2)
K DIR F D K SRM,SRCMOD Q:SRSOUT S SRQ=0
.S DIR("A")=" Modifier: ",DIR(0)="130.164,.01AO" S:$G(SRCMOD)'="" DIR("B")=SRCMOD D:$O(^SRF(SRDA(1),13,SRDA,"MOD",0)) QUES1
.D ^DIR K DIR S DA=SRDA,DA(1)=SRDA(1) I $D(DTOUT)!$D(DUOUT)!(X="") S SRSOUT=1 Q
.I +Y S SRJ=0 F S SRJ=$O(^SRF(SRDA(1),13,SRDA,"MOD",SRJ)) Q:'SRJ I $P(^SRF(SRDA(1),13,SRDA,"MOD",SRJ,0),"^")=+Y N DIR D Q
..S SRSEL=Y(0),DIR(0)="130.164,.01AO",DIR("A")=" Modifier: ",DIR("B")=$P(Y(0),"^")
..D ^DIR S DA=SRDA I $D(DTOUT)!$D(DUOUT)!(X="") S SRSOUT=1 Q
..I +Y S SRK=0 F S SRK=$O(^SRF(SRDA(1),13,SRDA,"MOD",SRK)) Q:'SRK I $P(^SRF(SRDA(1),13,SRDA,"MOD",SRK,0),"^")=+Y S Y="" Q
..I X="@" S SRY(130.164,SRJ_","_SRDA_","_SRDA(1)_",",.01)="@" D FILE^DIE("","SRY"),EN^DDIOL(" ... Modifier deleted","","?20") S SRQ=1
.Q:SRQ!SRSOUT
.I +Y S SRY(130.164,"+1,"_DA_","_DA(1)_",",.01)=+Y D UPDATE^DIE("","SRY") Q
.I X="@",$D(SRCMOD) S SRY(130.164,SRIEN_","_SRDA_",",SRDA(1)_",",.01)="@" D FILE^DIE("","SRY"),EN^DDIOL(" ... Modifier deleted","","?20")
Q
KOTH ; kill logic for ACPT1 x-ref
Q:$E($G(IOST))'="C"!($G(DIK)'="") K ^SRF(DA(1),13,DA,"MOD")
Q
HYPH27 ; input CPT hyphenated modifier for principal procedure
N SRCODE,SRDA,SRDUP,SRLIST,SRN,SROK,SRY S SRLIST=SRCMOD
F SRN=1:1 S SRCMOD=$P(SRLIST,",",SRN) Q:SRCMOD="" D
.S (SRDUP,SROK)=0
.S SRM=$P($$MOD^ICPTMOD(SRCMOD),"^") K:SRM<0 SRM I $D(SRM) D PCHK K SRM
.I 'SROK D EN^DDIOL("CPT Modifier '"_SRCMOD_"' is not acceptable with this CPT code.","","!") K SRCMOD Q
.S SRJ=0 F S SRJ=$O(^SRF(SRDA,"OPMOD",SRJ)) Q:'SRJ I $P(^SRF(SRDA,"OPMOD",SRJ,0),"^")=SROK S SRDUP=1 Q
.I 'SRDUP S SRY(130.028,"+1,"_DA_",",.01)=SROK D UPDATE^DIE("","SRY")
Q
HYPHOTH ; input CPT hyphenated modifier for other procedure
N SRCODE,SRDA,SRDUP,SRLIST,SRN,SROK,SROTH,SRY S SRLIST=SRCMOD
F SRN=1:1 S SRCMOD=$P(SRLIST,",",SRN) Q:SRCMOD="" D
.S (SRDUP,SROK)=0
.S SRM=$P($$MOD^ICPTMOD(SRCMOD),"^") K:SRM<0 SRM I $D(SRM) D OCHK K SRM
.I 'SROK D EN^DDIOL("CPT Modifier '"_SRCMOD_"' is not acceptable with this CPT code.","","!") K SRCMOD Q
.S SRJ=0 F S SRJ=$O(^SRF(SRDA,13,SROTH,"MOD",SRJ)) Q:'SRJ I $P(^SRF(SRDA,13,SROTH,"MOD",SRJ,0),"^")=SROK S SRDUP=1 Q
.I 'SRDUP S SRY(130.164,"+1,"_DA_","_DA(1)_",",.01)=SROK D UPDATE^DIE("","SRY")
Q
QUES N SRI,SRMD,SRX,SRY,SRZ S DIR("?",1)=" Answer with PRIN. PROCEDURE CPT MODIFIER",DIR("?",2)="Choose from:"
S SRI=0,SRCT=3 F S SRI=$O(^SRF(SRDA,"OPMOD",SRI)) Q:'SRI S SRMD=$P(^SRF(SRDA,"OPMOD",SRI,0),"^") D
.S SRX=$$MOD^ICPTMOD(SRMD,"I",$P($G(^SRF(SRDA,0)),"^",9)),SRY=$P(SRX,"^",2),SRZ=$P(SRX,"^",3)
.S DIR("?",SRCT)=" "_SRY_" "_SRZ,SRCT=SRCT+1
S DIR("?",SRCT)="",DIR("?")=" You may enter a new PRIN. PROCEDURE CPT MODIFIER, if you wish."
Q
QUES1 N SRI,SRMD,SRX,SRY,SRZ S DIR("?",1)=" Answer with OTHER PROCEDURE CPT MODIFIER",DIR("?",2)="Choose from:"
S SRI=0,SRCT=3 F S SRI=$O(^SRF(SRDA(1),13,SRDA,"MOD",SRI)) Q:'SRI S SRMD=$P(^SRF(SRDA(1),13,SRDA,"MOD",SRI,0),"^") D
.S SRX=$$MOD^ICPTMOD(SRMD,"I",$P($G(^SRF(SRDA,0)),"^",9)),SRY=$P(SRX,"^",2),SRZ=$P(SRX,"^",3)
.S DIR("?",SRCT)=" "_SRY_" "_SRZ,SRCT=SRCT+1
S DIR("?",SRCT)="",DIR("?")=" You may enter a new OTHER PROCEDURE CPT MODIFIER, if you wish."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROMOD 6660 printed Apr 09, 2024@21:45:36 Page 2
SROMOD ;BIR/ADM - CPT Modifier Input ; [ 02/27/01 6:32 AM ]
+1 ;;3.0;Surgery;**88,100,127,165,187**;24 Jun 93;Build 4
+2 QUIT
DISPLAY ; display name with modifier
+1 NEW SRY,SRDA,SRDATE
SET SRDATE=DT
+2 SET SRDA=$SELECT($GET(SRTN):SRTN,$DATA(DA(1)):DA(1),$DATA(DA):DA,1:"")
+3 IF $GET(SRDA)
SET SRDATE=$PIECE($GET(^SRF(SRDA,0)),"^",9)
+4 SET SRY=$$MOD^ICPTMOD(Y,"I",SRDATE)
if $PIECE(SRY,"^")=-1
QUIT
+5 SET Y=$PIECE(SRY,"^",2)_" "_$PIECE(SRY,"^",3)
+6 QUIT
SCR27() ; screen for acceptable CPT code/modifier pair for principal procedure
+1 NEW SRCODE,SRDA,SRCMOD,SROK,SRSDATE,SRZ
DO PCHK
KILL SRM
+2 QUIT SROK
PCHK ; return value of modifier if acceptable for principal procedure
+1 NEW SRSDATE
SET SRSDATE=DT
KILL ICPTVDT
+2 SET SROK=0
SET SRCODE=""
SET SRDA=$SELECT($GET(SRTN):SRTN,$DATA(DA(1)):DA(1),$DATA(DA):DA,1:"")
SET SRM=$SELECT($DATA(SRM):SRM,1:+Y)
+3 IF SRDA
SET SRSDATE=$PIECE(^SRF(SRDA,0),"^",9)
SET SRCODE=$PIECE($GET(^SRF(SRDA,"OP")),"^",2)
+4 ;;Begin *165 - RJS
+5 IF 'SRCODE!($GET(X)=51)
QUIT
+6 ;; End *165 - RJS
+7 SET SRZ=$PIECE($$MODP^ICPTMOD(SRCODE,SRM,"I",SRSDATE),"^")
IF SRZ>0
SET SROK=SRZ
+8 IF SROK
IF $DATA(^DIC(81.3,SROK,0))
IF $PIECE(^(0),U)=51
SET (SROK,SRZ)=0
+9 SET ICPTVDT=SRSDATE
+10 QUIT
OTH() ; screen for acceptable CPT code/modifier pair for other procedure
+1 NEW SRCODE,SRDA,SRCMOD,SROK,SROTH,SRSDATE,SRZ
DO OCHK
KILL SRM
+2 QUIT SROK
OCHK ; return value of modifier if acceptable for other procedure
+1 NEW SRSDATE
SET SRSDATE=DT
KILL ICPTVDT
+2 SET SROK=0
SET SRCODE=""
SET SRDA=$SELECT($GET(SRTN):SRTN,$DATA(DA(2)):DA(2),$DATA(DA(1)):DA(1),$DATA(D0):D0,1:"")
SET SROTH=$SELECT($DATA(DA):DA,$DATA(D1):D1,1:"")
SET SRM=$SELECT($DATA(SRM):SRM,1:+Y)
+3 IF SRDA&SROTH
SET SRSDATE=$PIECE(^SRF(SRDA,0),"^",9)
SET SRCODE=$PIECE($GET(^SRF(SRDA,13,SROTH,2)),"^")
+4 IF 'SRCODE
QUIT
+5 SET SRZ=$PIECE($$MODP^ICPTMOD(SRCODE,SRM,"I",SRSDATE),"^")
IF SRZ>0
SET SROK=SRZ
+6 SET ICPTVDT=SRSDATE
+7 QUIT
SPRIN ; set logic for ACPT x-ref
+1 if $EXTRACT($GET(IOST))'="C"!($GET(DIK)'="")
QUIT
+2 NEW SRCODE,SRDA,SRDEF,SRIEN,SRJ,SRQ,SRSDATE,SRSEL,SRSOUT,SRX,SRY,Z
SET (SRQ,SRSOUT)=0
SET SRCODE=X
NEW X
IF $DATA(SRCMOD)
DO HYPH27
+3 SET SRDA=DA
SET SRIEN=$ORDER(^SRF(SRDA,"OPMOD","AAA"),-1)
IF SRIEN
SET SRX=$PIECE(^SRF(SRDA,"OPMOD",SRIEN,0),"^")
SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRX,"I"),"^",2)
+4 KILL DIR
FOR
Begin DoDot:1
+5 SET DIR("A")=" Modifier: "
SET DIR(0)="130.028,.01AO"
if $GET(SRCMOD)'=""
SET DIR("B")=SRCMOD
if $ORDER(^SRF(SRDA,"OPMOD",0))
DO QUES
+6 DO ^DIR
KILL DIR
SET DA=SRDA
IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
SET SRSOUT=1
QUIT
+7 IF +Y
SET SRJ=0
FOR
SET SRJ=$ORDER(^SRF(SRDA,"OPMOD",SRJ))
if 'SRJ
QUIT
IF $PIECE(^SRF(SRDA,"OPMOD",SRJ,0),"^")=+Y
NEW DIR
Begin DoDot:2
+8 SET SRSEL=Y(0)
SET DIR(0)="130.028,.01AO"
SET DIR("A")=" Modifier: "
SET DIR("B")=$PIECE(Y(0),"^")
+9 DO ^DIR
SET DA=SRDA
IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
SET SRSOUT=1
QUIT
+10 IF +Y
SET SRK=0
FOR
SET SRK=$ORDER(^SRF(SRDA,"OPMOD",SRK))
if 'SRK
QUIT
IF $PIECE(^SRF(SRDA,"OPMOD",SRK,0),"^")=+Y
SET SRQ=1
QUIT
+11 if SRQ
QUIT
IF +Y
SET $PIECE(^SRF(SRDA,"OPMOD",SRJ,0),"^")=+Y
SET SRQ=1
QUIT
+12 IF X="@"
SET SRY(130.028,SRJ_","_SRDA_",",.01)="@"
DO FILE^DIE("","SRY")
DO EN^DDIOL(" ... Modifier deleted","","?20")
SET SRQ=1
End DoDot:2
QUIT
+13 if SRQ!SRSOUT
QUIT
+14 IF +Y
SET SRY(130.028,"+1,"_DA_",",.01)=+Y
DO UPDATE^DIE("","SRY")
QUIT
+15 IF X="@"
IF $DATA(SRCMOD)
SET SRY(130.028,SRIEN_","_SRDA_",",.01)="@"
DO FILE^DIE("","SRY")
DO EN^DDIOL(" ... Modifier deleted","","?20")
End DoDot:1
KILL SRM,SRCMOD
if SRSOUT
QUIT
SET SRQ=0
+16 QUIT
KPRIN ; kill logic for ACPT x-ref
+1 if $EXTRACT($GET(IOST))'="C"!($GET(DIK)'="")
QUIT
KILL ^SRF(DA,"OPMOD")
+2 QUIT
SOTH ; set logic for ACPT1 x-ref
+1 if $EXTRACT($GET(IOST))'="C"!($GET(DIK)'="")
QUIT
+2 NEW SRCODE,SRDA,SRDEF,SRIEN,SRJ,SRQ,SRSDATE,SRSEL,SRSOUT,SRX,SRY,Z
SET (SRQ,SRSOUT)=0
SET SRCODE=X
NEW X
IF $DATA(SRCMOD)
DO HYPHOTH
+3 SET SRDA=DA
SET SRDA(1)=DA(1)
SET SRIEN=$ORDER(^SRF(SRDA(1),13,SRDA,"MOD","A"),-1)
IF SRIEN
SET SRX=$PIECE(^SRF(SRDA(1),13,SRDA,"MOD",SRIEN,0),"^")
SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRX,"I"),"^",2)
+4 KILL DIR
FOR
Begin DoDot:1
+5 SET DIR("A")=" Modifier: "
SET DIR(0)="130.164,.01AO"
if $GET(SRCMOD)'=""
SET DIR("B")=SRCMOD
if $ORDER(^SRF(SRDA(1),13,SRDA,"MOD",0))
DO QUES1
+6 DO ^DIR
KILL DIR
SET DA=SRDA
SET DA(1)=SRDA(1)
IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
SET SRSOUT=1
QUIT
+7 IF +Y
SET SRJ=0
FOR
SET SRJ=$ORDER(^SRF(SRDA(1),13,SRDA,"MOD",SRJ))
if 'SRJ
QUIT
IF $PIECE(^SRF(SRDA(1),13,SRDA,"MOD",SRJ,0),"^")=+Y
NEW DIR
Begin DoDot:2
+8 SET SRSEL=Y(0)
SET DIR(0)="130.164,.01AO"
SET DIR("A")=" Modifier: "
SET DIR("B")=$PIECE(Y(0),"^")
+9 DO ^DIR
SET DA=SRDA
IF $DATA(DTOUT)!$DATA(DUOUT)!(X="")
SET SRSOUT=1
QUIT
+10 IF +Y
SET SRK=0
FOR
SET SRK=$ORDER(^SRF(SRDA(1),13,SRDA,"MOD",SRK))
if 'SRK
QUIT
IF $PIECE(^SRF(SRDA(1),13,SRDA,"MOD",SRK,0),"^")=+Y
SET Y=""
QUIT
+11 IF X="@"
SET SRY(130.164,SRJ_","_SRDA_","_SRDA(1)_",",.01)="@"
DO FILE^DIE("","SRY")
DO EN^DDIOL(" ... Modifier deleted","","?20")
SET SRQ=1
End DoDot:2
QUIT
+12 if SRQ!SRSOUT
QUIT
+13 IF +Y
SET SRY(130.164,"+1,"_DA_","_DA(1)_",",.01)=+Y
DO UPDATE^DIE("","SRY")
QUIT
+14 IF X="@"
IF $DATA(SRCMOD)
SET SRY(130.164,SRIEN_","_SRDA_",",SRDA(1)_",",.01)="@"
DO FILE^DIE("","SRY")
DO EN^DDIOL(" ... Modifier deleted","","?20")
End DoDot:1
KILL SRM,SRCMOD
if SRSOUT
QUIT
SET SRQ=0
+15 QUIT
KOTH ; kill logic for ACPT1 x-ref
+1 if $EXTRACT($GET(IOST))'="C"!($GET(DIK)'="")
QUIT
KILL ^SRF(DA(1),13,DA,"MOD")
+2 QUIT
HYPH27 ; input CPT hyphenated modifier for principal procedure
+1 NEW SRCODE,SRDA,SRDUP,SRLIST,SRN,SROK,SRY
SET SRLIST=SRCMOD
+2 FOR SRN=1:1
SET SRCMOD=$PIECE(SRLIST,",",SRN)
if SRCMOD=""
QUIT
Begin DoDot:1
+3 SET (SRDUP,SROK)=0
+4 SET SRM=$PIECE($$MOD^ICPTMOD(SRCMOD),"^")
if SRM<0
KILL SRM
IF $DATA(SRM)
DO PCHK
KILL SRM
+5 IF 'SROK
DO EN^DDIOL("CPT Modifier '"_SRCMOD_"' is not acceptable with this CPT code.","","!")
KILL SRCMOD
QUIT
+6 SET SRJ=0
FOR
SET SRJ=$ORDER(^SRF(SRDA,"OPMOD",SRJ))
if 'SRJ
QUIT
IF $PIECE(^SRF(SRDA,"OPMOD",SRJ,0),"^")=SROK
SET SRDUP=1
QUIT
+7 IF 'SRDUP
SET SRY(130.028,"+1,"_DA_",",.01)=SROK
DO UPDATE^DIE("","SRY")
End DoDot:1
+8 QUIT
HYPHOTH ; input CPT hyphenated modifier for other procedure
+1 NEW SRCODE,SRDA,SRDUP,SRLIST,SRN,SROK,SROTH,SRY
SET SRLIST=SRCMOD
+2 FOR SRN=1:1
SET SRCMOD=$PIECE(SRLIST,",",SRN)
if SRCMOD=""
QUIT
Begin DoDot:1
+3 SET (SRDUP,SROK)=0
+4 SET SRM=$PIECE($$MOD^ICPTMOD(SRCMOD),"^")
if SRM<0
KILL SRM
IF $DATA(SRM)
DO OCHK
KILL SRM
+5 IF 'SROK
DO EN^DDIOL("CPT Modifier '"_SRCMOD_"' is not acceptable with this CPT code.","","!")
KILL SRCMOD
QUIT
+6 SET SRJ=0
FOR
SET SRJ=$ORDER(^SRF(SRDA,13,SROTH,"MOD",SRJ))
if 'SRJ
QUIT
IF $PIECE(^SRF(SRDA,13,SROTH,"MOD",SRJ,0),"^")=SROK
SET SRDUP=1
QUIT
+7 IF 'SRDUP
SET SRY(130.164,"+1,"_DA_","_DA(1)_",",.01)=SROK
DO UPDATE^DIE("","SRY")
End DoDot:1
+8 QUIT
QUES NEW SRI,SRMD,SRX,SRY,SRZ
SET DIR("?",1)=" Answer with PRIN. PROCEDURE CPT MODIFIER"
SET DIR("?",2)="Choose from:"
+1 SET SRI=0
SET SRCT=3
FOR
SET SRI=$ORDER(^SRF(SRDA,"OPMOD",SRI))
if 'SRI
QUIT
SET SRMD=$PIECE(^SRF(SRDA,"OPMOD",SRI,0),"^")
Begin DoDot:1
+2 SET SRX=$$MOD^ICPTMOD(SRMD,"I",$PIECE($GET(^SRF(SRDA,0)),"^",9))
SET SRY=$PIECE(SRX,"^",2)
SET SRZ=$PIECE(SRX,"^",3)
+3 SET DIR("?",SRCT)=" "_SRY_" "_SRZ
SET SRCT=SRCT+1
End DoDot:1
+4 SET DIR("?",SRCT)=""
SET DIR("?")=" You may enter a new PRIN. PROCEDURE CPT MODIFIER, if you wish."
+5 QUIT
QUES1 NEW SRI,SRMD,SRX,SRY,SRZ
SET DIR("?",1)=" Answer with OTHER PROCEDURE CPT MODIFIER"
SET DIR("?",2)="Choose from:"
+1 SET SRI=0
SET SRCT=3
FOR
SET SRI=$ORDER(^SRF(SRDA(1),13,SRDA,"MOD",SRI))
if 'SRI
QUIT
SET SRMD=$PIECE(^SRF(SRDA(1),13,SRDA,"MOD",SRI,0),"^")
Begin DoDot:1
+2 SET SRX=$$MOD^ICPTMOD(SRMD,"I",$PIECE($GET(^SRF(SRDA,0)),"^",9))
SET SRY=$PIECE(SRX,"^",2)
SET SRZ=$PIECE(SRX,"^",3)
+3 SET DIR("?",SRCT)=" "_SRY_" "_SRZ
SET SRCT=SRCT+1
End DoDot:1
+4 SET DIR("?",SRCT)=""
SET DIR("?")=" You may enter a new OTHER PROCEDURE CPT MODIFIER, if you wish."
+5 QUIT
+6
