IBDFN4 ;ALB/CJM - ENCOUNTER FORM - (entry points for selection routines);5/21/93
;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
;
CPT ;select ambulatory procedures
N NAME,CODE,SCREEN,IBDESCR,IBDESCLG,QUIT
S QUIT=0
I '$D(@IBARY@("SCREEN")) D CPTSCRN Q:QUIT
E S SCREEN=$G(@IBARY@("SCREEN"))
K DIC S DIC=81,DIC(0)="AEMQZ",DIC("S")=SCREEN
I $D(^ICPT) D ^DIC K DIC I +Y>0 D
.;;change to api cpt;dhh
.S CODE=$P(Y(0),U)
.S CODE=$$CPT^ICPTCOD(CODE)
.I +CODE=-1 K @IBARY Q
.S NAME=$P(CODE,"^",3)
.S IBDESCLG=$$CPTD^ICPTCOD(+CODE,.IBCPTD)
.S IBDESCR=$G(IBCPTD(1))_" "_$G(IBCPTD(2))
.S @IBARY=$P(CODE,"^",2)_"^"_NAME_"^"_IBDESCR
E K @IBARY ;kill either if file doesn't exist or nothing chosen
Q
CPTSCRN ;
S SCREEN="I '$P(^(0),U,4)"
;
;don't ask the user about categories - it doesn't work well
;K DIR S DIR(0)="YA",DIR("A")="Do you want to select a CPT from a particular CPT category? ",DIR("?")="Answer YES if you want to screen out all CPT codes that do not belong to a particular category",DIR("B")="NO"
;I $D(^DIC(81.1)) D ^DIR K DIR S:$D(DIRUT) QUIT=1 Q:$D(DIRUT) I +Y D
;.K DIC S DIC="81.1",DIC(0)="AEQ",DIC("S")="I $P(^(0),U,2)=""m"""
;.D ^DIC K DIC I +Y>0 S SCREEN=SCREEN_",$P($G(^DIC(81.1,+$P(^(0),U,3),0)),U,3)="_+Y
S @IBARY@("SCREEN")=SCREEN
Q
;
ICD9 ;select ICD-9 codes
N IBDX,CODE,SCREEN,IBDESCR,QUIT
S QUIT=0
I $D(@IBARY@("SCREEN")) S SCREEN=$G(@IBARY@("SCREEN"))
E D ICD9SCRN Q:QUIT
S DIC=80,DIC(0)="AEMQZI",DIC("S")=SCREEN
I $D(^ICD9) D ^DIC K DIC I +Y>0 D
.S CODE=$P(Y(0),U),IBDX=$P(Y(0),U,3),IBDESCR=$P($G(^ICD9(+Y,1)),"^")
.S @IBARY=CODE_"^"_IBDX_"^"_IBDESCR
E K @IBARY ;kill if either file doesn't exist or nothing chosen - this is how to let the encounter form utilities know nothing was selected
Q
ICD9SCRN ;
S SCREEN="I '$P(^(0),U,9)"
;
;don't ask the user about categories - it doesn't work well
;K DIR S DIR(0)="YA",DIR("A")="Do you want to select an ICD diagnosis from a particular diagnostic category? ",DIR("B")="NO"
;S DIR("?")="Answer YES if you want to screen out all diagnosis codes that do not belong to a particular category"
;I $D(^DIC(80.3)) D ^DIR K DIR S:$D(DIRUT) QUIT=1 Q:$D(DIRUT) I +Y D
;.K DIC S DIC="80.3",DIC(0)="AEQ"
;.D ^DIC K DIC I +Y>0 S SCREEN=SCREEN_",+$P(^(0),U,5)="_+Y
S @IBARY@("SCREEN")=SCREEN
Q
NULL ;returns NOTHING for selection
S @IBARY=""
Q
;
VSIT ; -- Select only visit cpt codes
N NAME,CODE,IBDESCR,QUIT,DIC,X,Y,IBHDR,IBTXT
S QUIT=0
;
S DIC="^IBE(357.69,",DIC(0)="AEMQZ",DIC("S")="I '$P(^(0),U,4)"
D ^DIC K DIC I +Y>0 D
.;;----change to api cpt;dhh
.S CODE=$P(Y(0),U),IBHDR=$P(Y(0),U,2),IBTXT=$P(Y(0),U,3)
.S NODE=$$CPT^ICPTCOD(CODE)
.I +NODE=-1 S IBSNM="" Q
.S IBSNM=$P(NODE,U,3)
.S @IBARY=CODE_"^"_IBTXT_"^"_IBHDR_"^"_IBSNM
E K @IBARY ;kill if nothing chosen
Q
;
PRVDR ;for selecting provider
D GETPRO^IBDF18B(IBCLINIC,IBARY)
Q
;
IBPFID ;for printing the form # assigned by form tracking
S @IBARY=$G(IBPFID)
Q
;
PCPR ; -- get primary care provider for a patient
S @IBARY=$P($$OUTPTPR^SDUTL3(DFN,DT),"^",2)
Q
;
PCTM ; -- get primary care team for a patient
S @IBARY=$P($$OUTPTTM^SDUTL3(DFN,DT),"^",2)
Q
;
SCCOND ; -- display sc conditions
Q:'$G(DFN)
D DIS^DGRPDB
W !
Q
;
;
CPTMOD ;- Select active CPT Modifiers
;- (used in selecting CPT Modifier(s) when creating the CPT Modifier
; Display ToolKit Block)
;
N CODE,DIC,NAME,SCREEN
Q:$G(IBARY)=""
;
;- Screen out inactive CPT modifiers
S SCREEN="I '$P(^(0),U,5)"
I '$D(@IBARY@("SCREEN")) S @IBARY@("SCREEN")=SCREEN
S DIC=81.3
S DIC(0)="AEMQZ"
S DIC("S")=SCREEN
D ^DIC
I +Y>0 D
. ;- Use first 35 chars of modifier description
. S CODE=$P(Y(0),"^"),NAME=$E($P(Y(0),"^",2),1,35)
. S @IBARY=CODE_"^"_NAME
;
;- Kill if file doesn't exist or nothing chosen
E K @IBARY
Q
IBDFN4 ;ALB/CJM - ENCOUNTER FORM - (entry points for selection routines);5/21/93
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**38**;APR 24, 1997
+2 ;
CPT ;select ambulatory procedures
+1 NEW NAME,CODE,SCREEN,IBDESCR,IBDESCLG,QUIT
+2 SET QUIT=0
+3 IF '$DATA(@IBARY@("SCREEN"))
DO CPTSCRN
IF QUIT
QUIT
+4 IF '$TEST
SET SCREEN=$GET(@IBARY@("SCREEN"))
+5 KILL DIC
SET DIC=81
SET DIC(0)="AEMQZ"
SET DIC("S")=SCREEN
+6 IF $DATA(^ICPT)
DO ^DIC
KILL DIC
IF +Y>0
Begin DoDot:1
+7 ;;change to api cpt;dhh
+8 SET CODE=$PIECE(Y(0),U)
+9 SET CODE=$$CPT^ICPTCOD(CODE)
+10 IF +CODE=-1
KILL @IBARY
QUIT
+11 SET NAME=$PIECE(CODE,"^",3)
+12 SET IBDESCLG=$$CPTD^ICPTCOD(+CODE,.IBCPTD)
+13 SET IBDESCR=$GET(IBCPTD(1))_" "_$GET(IBCPTD(2))
+14 SET @IBARY=$PIECE(CODE,"^",2)_"^"_NAME_"^"_IBDESCR
End DoDot:1
+15 ;kill either if file doesn't exist or nothing chosen
IF '$TEST
KILL @IBARY
+16 QUIT
CPTSCRN ;
+1 SET SCREEN="I '$P(^(0),U,4)"
+2 ;
+3 ;don't ask the user about categories - it doesn't work well
+4 ;K DIR S DIR(0)="YA",DIR("A")="Do you want to select a CPT from a particular CPT category? ",DIR("?")="Answer YES if you want to screen out all CPT codes that do not belong to a particular category",DIR("B")="NO"
+5 ;I $D(^DIC(81.1)) D ^DIR K DIR S:$D(DIRUT) QUIT=1 Q:$D(DIRUT) I +Y D
+6 ;.K DIC S DIC="81.1",DIC(0)="AEQ",DIC("S")="I $P(^(0),U,2)=""m"""
+7 ;.D ^DIC K DIC I +Y>0 S SCREEN=SCREEN_",$P($G(^DIC(81.1,+$P(^(0),U,3),0)),U,3)="_+Y
+8 SET @IBARY@("SCREEN")=SCREEN
+9 QUIT
+10 ;
ICD9 ;select ICD-9 codes
+1 NEW IBDX,CODE,SCREEN,IBDESCR,QUIT
+2 SET QUIT=0
+3 IF $DATA(@IBARY@("SCREEN"))
SET SCREEN=$GET(@IBARY@("SCREEN"))
+4 IF '$TEST
DO ICD9SCRN
IF QUIT
QUIT
+5 SET DIC=80
SET DIC(0)="AEMQZI"
SET DIC("S")=SCREEN
+6 IF $DATA(^ICD9)
DO ^DIC
KILL DIC
IF +Y>0
Begin DoDot:1
+7 SET CODE=$PIECE(Y(0),U)
SET IBDX=$PIECE(Y(0),U,3)
SET IBDESCR=$PIECE($GET(^ICD9(+Y,1)),"^")
+8 SET @IBARY=CODE_"^"_IBDX_"^"_IBDESCR
End DoDot:1
+9 ;kill if either file doesn't exist or nothing chosen - this is how to let the encounter form utilities know nothing was selected
IF '$TEST
KILL @IBARY
+10 QUIT
ICD9SCRN ;
+1 SET SCREEN="I '$P(^(0),U,9)"
+2 ;
+3 ;don't ask the user about categories - it doesn't work well
+4 ;K DIR S DIR(0)="YA",DIR("A")="Do you want to select an ICD diagnosis from a particular diagnostic category? ",DIR("B")="NO"
+5 ;S DIR("?")="Answer YES if you want to screen out all diagnosis codes that do not belong to a particular category"
+6 ;I $D(^DIC(80.3)) D ^DIR K DIR S:$D(DIRUT) QUIT=1 Q:$D(DIRUT) I +Y D
+7 ;.K DIC S DIC="80.3",DIC(0)="AEQ"
+8 ;.D ^DIC K DIC I +Y>0 S SCREEN=SCREEN_",+$P(^(0),U,5)="_+Y
+9 SET @IBARY@("SCREEN")=SCREEN
+10 QUIT
NULL ;returns NOTHING for selection
+1 SET @IBARY=""
+2 QUIT
+3 ;
VSIT ; -- Select only visit cpt codes
+1 NEW NAME,CODE,IBDESCR,QUIT,DIC,X,Y,IBHDR,IBTXT
+2 SET QUIT=0
+3 ;
+4 SET DIC="^IBE(357.69,"
SET DIC(0)="AEMQZ"
SET DIC("S")="I '$P(^(0),U,4)"
+5 DO ^DIC
KILL DIC
IF +Y>0
Begin DoDot:1
+6 ;;----change to api cpt;dhh
+7 SET CODE=$PIECE(Y(0),U)
SET IBHDR=$PIECE(Y(0),U,2)
SET IBTXT=$PIECE(Y(0),U,3)
+8 SET NODE=$$CPT^ICPTCOD(CODE)
+9 IF +NODE=-1
SET IBSNM=""
QUIT
+10 SET IBSNM=$PIECE(NODE,U,3)
+11 SET @IBARY=CODE_"^"_IBTXT_"^"_IBHDR_"^"_IBSNM
End DoDot:1
+12 ;kill if nothing chosen
IF '$TEST
KILL @IBARY
+13 QUIT
+14 ;
PRVDR ;for selecting provider
+1 DO GETPRO^IBDF18B(IBCLINIC,IBARY)
+2 QUIT
+3 ;
IBPFID ;for printing the form # assigned by form tracking
+1 SET @IBARY=$GET(IBPFID)
+2 QUIT
+3 ;
PCPR ; -- get primary care provider for a patient
+1 SET @IBARY=$PIECE($$OUTPTPR^SDUTL3(DFN,DT),"^",2)
+2 QUIT
+3 ;
PCTM ; -- get primary care team for a patient
+1 SET @IBARY=$PIECE($$OUTPTTM^SDUTL3(DFN,DT),"^",2)
+2 QUIT
+3 ;
SCCOND ; -- display sc conditions
+1 IF '$GET(DFN)
QUIT
+2 DO DIS^DGRPDB
+3 WRITE !
+4 QUIT
+5 ;
+6 ;
CPTMOD ;- Select active CPT Modifiers
+1 ;- (used in selecting CPT Modifier(s) when creating the CPT Modifier
+2 ; Display ToolKit Block)
+3 ;
+4 NEW CODE,DIC,NAME,SCREEN
+5 IF $GET(IBARY)=""
QUIT
+6 ;
+7 ;- Screen out inactive CPT modifiers
+8 SET SCREEN="I '$P(^(0),U,5)"
+9 IF '$DATA(@IBARY@("SCREEN"))
SET @IBARY@("SCREEN")=SCREEN
+10 SET DIC=81.3
+11 SET DIC(0)="AEMQZ"
+12 SET DIC("S")=SCREEN
+13 DO ^DIC
+14 IF +Y>0
Begin DoDot:1
+15 ;- Use first 35 chars of modifier description
+16 SET CODE=$PIECE(Y(0),"^")
SET NAME=$EXTRACT($PIECE(Y(0),"^",2),1,35)
+17 SET @IBARY=CODE_"^"_NAME
End DoDot:1
+18 ;
+19 ;- Kill if file doesn't exist or nothing chosen
+20 IF '$TEST
KILL @IBARY
+21 QUIT
