Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFDE23

IBDFDE23.m

Go to the documentation of this file.
  1. 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
  1. MOD ;Entry point for selecting or modifying modifiers
  1. ;
  1. ; -- called by IBDFDE21
  1. ;
  1. N CODE,I,X,SEL,MOD,Y,CNT,MODLST
  1. ;
  1. ;-- result is definition is noted in ^ibdfde2
  1. ; result:= pckg interface^code to send^text to send...
  1. ;
  1. S CODE=$P(RESULT(IBDX),"^",2)
  1. ;
  1. ; --ans = list number, cpt, or cpt-mod,mod (raw data user enters)
  1. ; if ans contains "-" then seperate and validate each cpt modifier pair
  1. ; if ans contains "-" ans should = cpt-mod,mod,mod...
  1. ; else ask for modifiers
  1. ;
  1. I ANS["-" D
  1. .S MODLST=$P(ANS,"-",2)
  1. .F I=1:1 S X=$P(MODLST,",",I) Q:X']"" D
  1. ..; --check for appropriate modifiers/cpt matches
  1. ..; cpts and modifiers can be input as
  1. ..; -- cpt-mod,mod,mod
  1. ..; if multiple modifiers were entered with cpt, each cpt-mod pair
  1. ..; will be checked by modp^icptmod to see if valid. if not, an
  1. ..; error message will be displayed for the invalid code pair
  1. ..;
  1. .. I $$MODP^ICPTMOD(CODE,X)'>0 D ERR Q
  1. .. S SEL("MOD",X)=""
  1. ;
  1. ; --no matter what method user uses to input data modifiers should
  1. ; should be asked for each cpt code
  1. ;
  1. D OTHER,ARRAY
  1. Q
  1. ;
  1. OTHER ;--allow for additional modifiers to be selected
  1. N DIC
  1. F S DIC=81.3,DIC("S")="I ($$MODP^ICPTMOD(CODE,+Y,""I""))>0",DIC(0)="AEMQ" D ^DIC Q:+Y<1 D
  1. . S MOD=$P($G(Y),"^",2)
  1. . I $D(SEL("MOD",MOD)) D DELMOD Q:Y=1
  1. . S:MOD'="" SEL("MOD",MOD)=""
  1. Q
  1. DELMOD ; Delete modifier from list if duplicate entry
  1. N DIR,DA,DR,DIC
  1. W !,"Do you want to remove this modifier as being Associated with this CPT Procedure?"
  1. S DIR(0)="Y",DIR("B")="YES" D ^DIR Q:$D(DIRUT)
  1. I Y=1 K SEL("MOD",MOD)
  1. Q
  1. ARRAY ; -- transfer modifier data to result array
  1. Q:'$D(SEL)
  1. S MOD="",CNT=0 F S MOD=$O(SEL("MOD",MOD)) Q:MOD']"" D
  1. . S CNT=CNT+1
  1. . S RESULT(IBDX,"MODIFIER",CNT)=MOD
  1. S RESULT(IBDX,"MODIFIER",0)=CNT
  1. Q
  1. ;
  1. ERR ;Error message
  1. W !,X," is not a valid modifier for ",CODE,!
  1. Q
  1. GAFSCOR ;Enter GAF Score
  1. ;GAFCNT is newed in % of IBDFDE,IBDFDE6,IBDFDE7
  1. S GAFCNT=$G(GAFCNT)+1
  1. I GAFCNT=2 Q
  1. I GAFCNT>2 K GAFCNT Q
  1. S DIR(0)="N^1:100"
  1. S DIR("A")="Enter GAF Score "
  1. S DIR("?")="GAF Score is numeric from 1-100."
  1. D ^DIR
  1. I Y<1 D G GAFSCOR
  1. . W "You must enter a GAF Score (1-100)!"
  1. . S GAFCNT=$G(GAFCNT)-1
  1. S IBDSEL(0)=$G(IBDSEL(0))+1
  1. S IBDSEL(IBDSEL(0))=IBDF("PI")_"^"_+Y_"^ ^^^^^GAF SCORE"
  1. S $P(PXCA("IBD GAF SCORE",0),"^")=+Y
  1. Q
  1. ;
  1. OKPROV(IEN) ; Screen for provider lookup using person class
  1. Q ($D(^XUSEC("SD GAF SCORE",IEN)))
  1. ;