IBDFDE23 ;ALB/DHH - Select CPT Modifiers during Manual Data Entry ; MAY-18-1999
;;3.0;AUTOMATED INFO COLLECTION SYS;**38,37**;APR 24, 1997
MOD ;Entry point for selecting or modifying modifiers
;
; -- called by IBDFDE21
;
N CODE,I,X,SEL,MOD,Y,CNT,MODLST
;
;-- result is definition is noted in ^ibdfde2
; result:= pckg interface^code to send^text to send...
;
S CODE=$P(RESULT(IBDX),"^",2)
;
; --ans = list number, cpt, or cpt-mod,mod (raw data user enters)
; if ans contains "-" then seperate and validate each cpt modifier pair
; if ans contains "-" ans should = cpt-mod,mod,mod...
; else ask for modifiers
;
I ANS["-" D
.S MODLST=$P(ANS,"-",2)
.F I=1:1 S X=$P(MODLST,",",I) Q:X']"" D
..; --check for appropriate modifiers/cpt matches
..; cpts and modifiers can be input as
..; -- cpt-mod,mod,mod
..; if multiple modifiers were entered with cpt, each cpt-mod pair
..; will be checked by modp^icptmod to see if valid. if not, an
..; error message will be displayed for the invalid code pair
..;
.. I $$MODP^ICPTMOD(CODE,X)'>0 D ERR Q
.. S SEL("MOD",X)=""
;
; --no matter what method user uses to input data modifiers should
; should be asked for each cpt code
;
D OTHER,ARRAY
Q
;
OTHER ;--allow for additional modifiers to be selected
N DIC
F S DIC=81.3,DIC("S")="I ($$MODP^ICPTMOD(CODE,+Y,""I""))>0",DIC(0)="AEMQ" D ^DIC Q:+Y<1 D
. S MOD=$P($G(Y),"^",2)
. I $D(SEL("MOD",MOD)) D DELMOD Q:Y=1
. S:MOD'="" SEL("MOD",MOD)=""
Q
DELMOD ; Delete modifier from list if duplicate entry
N DIR,DA,DR,DIC
W !,"Do you want to remove this modifier as being Associated with this CPT Procedure?"
S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:$D(DIRUT)
I Y=1 K SEL("MOD",MOD)
Q
ARRAY ; -- transfer modifier data to result array
Q:'$D(SEL)
S MOD="",CNT=0 F S MOD=$O(SEL("MOD",MOD)) Q:MOD']"" D
. S CNT=CNT+1
. S RESULT(IBDX,"MODIFIER",CNT)=MOD
S RESULT(IBDX,"MODIFIER",0)=CNT
Q
;
ERR ;Error message
W !,X," is not a valid modifier for ",CODE,!
Q
GAFSCOR ;Enter GAF Score
;GAFCNT is newed in % of IBDFDE,IBDFDE6,IBDFDE7
S GAFCNT=$G(GAFCNT)+1
I GAFCNT=2 Q
I GAFCNT>2 K GAFCNT Q
S DIR(0)="N^1:100"
S DIR("A")="Enter GAF Score "
S DIR("?")="GAF Score is numeric from 1-100."
D ^DIR
I Y<1 D G GAFSCOR
. W "You must enter a GAF Score (1-100)!"
. S GAFCNT=$G(GAFCNT)-1
S IBDSEL(0)=$G(IBDSEL(0))+1
S IBDSEL(IBDSEL(0))=IBDF("PI")_"^"_+Y_"^ ^^^^^GAF SCORE"
S $P(PXCA("IBD GAF SCORE",0),"^")=+Y
Q
;
OKPROV(IEN) ; Screen for provider lookup using person class
Q ($D(^XUSEC("SD GAF SCORE",IEN)))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFDE23 2648 printed Dec 13, 2024@02:52:18 Page 2
IBDFDE23 ;ALB/DHH - Select CPT Modifiers during Manual Data Entry ; MAY-18-1999
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,37**;APR 24, 1997
MOD ;Entry point for selecting or modifying modifiers
+1 ;
+2 ; -- called by IBDFDE21
+3 ;
+4 NEW CODE,I,X,SEL,MOD,Y,CNT,MODLST
+5 ;
+6 ;-- result is definition is noted in ^ibdfde2
+7 ; result:= pckg interface^code to send^text to send...
+8 ;
+9 SET CODE=$PIECE(RESULT(IBDX),"^",2)
+10 ;
+11 ; --ans = list number, cpt, or cpt-mod,mod (raw data user enters)
+12 ; if ans contains "-" then seperate and validate each cpt modifier pair
+13 ; if ans contains "-" ans should = cpt-mod,mod,mod...
+14 ; else ask for modifiers
+15 ;
+16 IF ANS["-"
Begin DoDot:1
+17 SET MODLST=$PIECE(ANS,"-",2)
+18 FOR I=1:1
SET X=$PIECE(MODLST,",",I)
if X']""
QUIT
Begin DoDot:2
+19 ; --check for appropriate modifiers/cpt matches
+20 ; cpts and modifiers can be input as
+21 ; -- cpt-mod,mod,mod
+22 ; if multiple modifiers were entered with cpt, each cpt-mod pair
+23 ; will be checked by modp^icptmod to see if valid. if not, an
+24 ; error message will be displayed for the invalid code pair
+25 ;
+26 IF $$MODP^ICPTMOD(CODE,X)'>0
DO ERR
QUIT
+27 SET SEL("MOD",X)=""
End DoDot:2
End DoDot:1
+28 ;
+29 ; --no matter what method user uses to input data modifiers should
+30 ; should be asked for each cpt code
+31 ;
+32 DO OTHER
DO ARRAY
+33 QUIT
+34 ;
OTHER ;--allow for additional modifiers to be selected
+1 NEW DIC
+2 FOR
SET DIC=81.3
SET DIC("S")="I ($$MODP^ICPTMOD(CODE,+Y,""I""))>0"
SET DIC(0)="AEMQ"
DO ^DIC
if +Y<1
QUIT
Begin DoDot:1
+3 SET MOD=$PIECE($GET(Y),"^",2)
+4 IF $DATA(SEL("MOD",MOD))
DO DELMOD
if Y=1
QUIT
+5 if MOD'=""
SET SEL("MOD",MOD)=""
End DoDot:1
+6 QUIT
DELMOD ; Delete modifier from list if duplicate entry
+1 NEW DIR,DA,DR,DIC
+2 WRITE !,"Do you want to remove this modifier as being Associated with this CPT Procedure?"
+3 SET DIR(0)="Y"
SET DIR("B")="YES"
DO ^DIR
if $DATA(DIRUT)
QUIT
+4 IF Y=1
KILL SEL("MOD",MOD)
+5 QUIT
ARRAY ; -- transfer modifier data to result array
+1 if '$DATA(SEL)
QUIT
+2 SET MOD=""
SET CNT=0
FOR
SET MOD=$ORDER(SEL("MOD",MOD))
if MOD']""
QUIT
Begin DoDot:1
+3 SET CNT=CNT+1
+4 SET RESULT(IBDX,"MODIFIER",CNT)=MOD
End DoDot:1
+5 SET RESULT(IBDX,"MODIFIER",0)=CNT
+6 QUIT
+7 ;
ERR ;Error message
+1 WRITE !,X," is not a valid modifier for ",CODE,!
+2 QUIT
GAFSCOR ;Enter GAF Score
+1 ;GAFCNT is newed in % of IBDFDE,IBDFDE6,IBDFDE7
+2 SET GAFCNT=$GET(GAFCNT)+1
+3 IF GAFCNT=2
QUIT
+4 IF GAFCNT>2
KILL GAFCNT
QUIT
+5 SET DIR(0)="N^1:100"
+6 SET DIR("A")="Enter GAF Score "
+7 SET DIR("?")="GAF Score is numeric from 1-100."
+8 DO ^DIR
+9 IF Y<1
Begin DoDot:1
+10 WRITE "You must enter a GAF Score (1-100)!"
+11 SET GAFCNT=$GET(GAFCNT)-1
End DoDot:1
GOTO GAFSCOR
+12 SET IBDSEL(0)=$GET(IBDSEL(0))+1
+13 SET IBDSEL(IBDSEL(0))=IBDF("PI")_"^"_+Y_"^ ^^^^^GAF SCORE"
+14 SET $PIECE(PXCA("IBD GAF SCORE",0),"^")=+Y
+15 QUIT
+16 ;
OKPROV(IEN) ; Screen for provider lookup using person class
+1 QUIT ($DATA(^XUSEC("SD GAF SCORE",IEN)))
+2 ;
