ECED2 ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;7 May 96
;;2.0; EVENT CAPTURE ;**1,4,5,13,18,47**;8 May 96
NEW ; create new procedure
S (EC1,OK)=0 K ECHOICE,ECSTOP
I '$D(ECC(1)) S ECC=+$P(ECC(0),"^"),ECCN="None" G P
I '$D(ECC(2)) S ECC=+ECC(1),ECCN=$P(ECC(1),"^",2) G P
S X="",CNT=0
LIST W:$D(EC(1))!($Y+5>IOSL) @IOF W !,"Categories within "_ECDN_": ",! S EC1=0 F I=0:0 S CNT=$O(ECC(CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_". ",?5,$P(ECC(CNT),"^",2)
I '$D(ECSTOP),$D(ECHOICE) G P
PICK W !!,"Select Number: " R X:DTIME I '$T!("^"[X) S ECOUT=1 Q
I '$D(ECC(X)) W !!,"Select the number corresponding to the category, or ^ to quit.",!!,"Press <RET> to continue ",! R X:DTIME K ECHOICE,ECSTOP S CNT=CNT-5,X="" G LIST
S ECC=+$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2)
W !,"Category: "_ECCN,!
P ; get procedure
I '$D(ECC) W !!,"Category not defined.",! D MSG^ECEDU Q
D PROS^ECHECK1
I '$O(^TMP("ECPRO",$J,0)) D Q:ECOUT
.W !!,"Within the ",ECLN," location there are no procedures defined",!
.W "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
.W "Press <RET> to continue " R X:DTIME S ECOUT=2 Q
P1 ;
I '$D(^TMP("ECPRO",$J,2)) S CNT=1 D SETP W !,"Procedure: " D G FILE
. W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
. W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
P2 ;ask mul proc
S EC1=1
S ECX="",(ECPCNT,CNT,OK)=0 K ECHOICE,ECSTOP
;
;New code for procedure entry/lookup
S DIR("?")="^D PROS^ECED2"
S ECX=$$GETPRO^ECDSUTIL
I +$G(ECX)=-1 D MSG^ECEDU,KILLV^ECDSUTIL Q
I +$G(ECX)=1 D SRCHTM^ECDSUTIL(ECX)
S ECPCNT=+$G(ECPCNT)
I ECPCNT=-1!(ECPCNT=-2) D G P2
. D @($S(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
. D KILLV^ECDSUTIL
I ECPCNT>0 D G FILE
. S CNT=ECPCNT
. D SETP
. S OK=1
. D KILLV^ECDSUTIL
I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL
I CNT=-1 D MSG^ECEDU,KILLV^ECDSUTIL Q
I CNT>0 D G FILE
. D SETP
. S OK=1
. D KILLV^ECDSUTIL
Q
;
PROS ;
LISTP N X,CNT
S X="",CNT=0 K ECHOICE,ECSTOP
D HDR1^ECEDU S JJ=1 W !,"Available Procedures within "_ECDN_": ",!
W ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
S EC1=1
F S CNT=$O(^TMP("ECPRO",$J,CNT)) Q:'CNT!$D(ECHOICE) D:($Y+5>IOSL) SELC Q:$D(ECHOICE) I X="" W !,CNT_".",?5,$E($P(^TMP("ECPRO",$J,CNT),"^",4),1,30),?38,$E($P(^(CNT),"^",3),1,30),?72,$P(^(CNT),"^",5)
I X="" D
.W !!?5,"Select by number, CPT or national code, procedure name, or synonym."
.W !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
.W ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
Q
;
FILE ;file pro
D HDR^ECEDU
D ^ECEDF
Q
SETP ;set proc info
S ECJJ=0
S ECP=$P(^TMP("ECPRO",$J,CNT),"^"),ECPN=$P(^(CNT),"^",4),NATN=$P(^(CNT),"^",5),ECVOL=$P(^(CNT),"^",6),SYN=$P(^(CNT),"^",3),EC4=$P(^(CNT),"^",2)
S ECCPT=$S(ECP["EC":$P($G(^EC(725,+ECP,0)),"^",5),1:+ECP)
S ECPTCD="" I ECCPT'="" D
. S ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT)
. I +ECPTCD>0 S ECPTCD=$P(ECPTCD,U,2)
W " "_$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
S EC4=$P($G(^ECJ(+EC4,"PRO")),"^",4)
S EC4N=$S($P($G(^SC(+EC4,0)),"^")]"":$P(^(0),"^"),1:""),ECID=$P($G(^SC(+EC4,0)),"^",7)
S ^TMP("ECLKUP",$J,"LAST")=CNT
Q
SELC ; select category
W !!,$S(EC1:"Press",1:"Select Number, or press")_" <RET> to continue listing "_$S(EC1:"procedures",1:"categories")_" or '^' to stop: " R X:DTIME I '$T!(X="^") S (ECSTOP,ECHOICE)=1 Q
I X="" W @IOF,!,$S(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",! Q
I 'EC1,'$D(ECC(X)) D MSGC^ECEDU Q
I EC1,'$D(^TMP("ECPRO",$J,X)) D MSGC^ECEDU Q
S ECHOICE=1
I 'EC1 S ECC=+$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECED2 3810 printed Oct 16, 2024@17:58:05 Page 2
ECED2 ;BIR/MAM,JPW-Enter Event Capture Data (cont'd) ;7 May 96
+1 ;;2.0; EVENT CAPTURE ;**1,4,5,13,18,47**;8 May 96
NEW ; create new procedure
+1 SET (EC1,OK)=0
KILL ECHOICE,ECSTOP
+2 IF '$DATA(ECC(1))
SET ECC=+$PIECE(ECC(0),"^")
SET ECCN="None"
GOTO P
+3 IF '$DATA(ECC(2))
SET ECC=+ECC(1)
SET ECCN=$PIECE(ECC(1),"^",2)
GOTO P
+4 SET X=""
SET CNT=0
LIST if $DATA(EC(1))!($Y+5>IOSL)
WRITE @IOF
WRITE !,"Categories within "_ECDN_": ",!
SET EC1=0
FOR I=0:0
SET CNT=$ORDER(ECC(CNT))
if 'CNT!$DATA(ECHOICE)
QUIT
if ($Y+5>IOSL)
DO SELC
if $DATA(ECHOICE)
QUIT
IF X=""
WRITE !,CNT_". ",?5,$PIECE(ECC(CNT),"^",2)
+1 IF '$DATA(ECSTOP)
IF $DATA(ECHOICE)
GOTO P
PICK WRITE !!,"Select Number: "
READ X:DTIME
IF '$TEST!("^"[X)
SET ECOUT=1
QUIT
+1 IF '$DATA(ECC(X))
WRITE !!,"Select the number corresponding to the category, or ^ to quit.",!!,"Press <RET> to continue ",!
READ X:DTIME
KILL ECHOICE,ECSTOP
SET CNT=CNT-5
SET X=""
GOTO LIST
+2 SET ECC=+$PIECE(ECC(X),"^")
SET ECCN=$PIECE(ECC(X),"^",2)
+3 WRITE !,"Category: "_ECCN,!
P ; get procedure
+1 IF '$DATA(ECC)
WRITE !!,"Category not defined.",!
DO MSG^ECEDU
QUIT
+2 DO PROS^ECHECK1
+3 IF '$ORDER(^TMP("ECPRO",$JOB,0))
Begin DoDot:1
+4 WRITE !!,"Within the ",ECLN," location there are no procedures defined",!
+5 WRITE "for the DSS Unit ",ECDN,". Please select another DSS Unit.",!!
+6 WRITE "Press <RET> to continue "
READ X:DTIME
SET ECOUT=2
QUIT
End DoDot:1
if ECOUT
QUIT
P1 ;
+1 IF '$DATA(^TMP("ECPRO",$JOB,2))
SET CNT=1
DO SETP
WRITE !,"Procedure: "
Begin DoDot:1
+2 WRITE $SELECT(ECCPT="":"",1:ECPTCD_" ")_$EXTRACT(ECPN,1,50)
+3 WRITE $SELECT(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
End DoDot:1
GOTO FILE
P2 ;ask mul proc
+1 SET EC1=1
+2 SET ECX=""
SET (ECPCNT,CNT,OK)=0
KILL ECHOICE,ECSTOP
+3 ;
+4 ;New code for procedure entry/lookup
+5 SET DIR("?")="^D PROS^ECED2"
+6 SET ECX=$$GETPRO^ECDSUTIL
+7 IF +$GET(ECX)=-1
DO MSG^ECEDU
DO KILLV^ECDSUTIL
QUIT
+8 IF +$GET(ECX)=1
DO SRCHTM^ECDSUTIL(ECX)
+9 SET ECPCNT=+$GET(ECPCNT)
+10 IF ECPCNT=-1!(ECPCNT=-2)
Begin DoDot:1
+11 DO @($SELECT(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
+12 DO KILLV^ECDSUTIL
End DoDot:1
GOTO P2
+13 IF ECPCNT>0
Begin DoDot:1
+14 SET CNT=ECPCNT
+15 DO SETP
+16 SET OK=1
+17 DO KILLV^ECDSUTIL
End DoDot:1
GOTO FILE
+18 IF 'ECPCNT
IF $DATA(ECPNAME)
SET CNT=$$PRLST^ECDSUTIL
+19 IF CNT=-1
DO MSG^ECEDU
DO KILLV^ECDSUTIL
QUIT
+20 IF CNT>0
Begin DoDot:1
+21 DO SETP
+22 SET OK=1
+23 DO KILLV^ECDSUTIL
End DoDot:1
GOTO FILE
+24 QUIT
+25 ;
PROS ;
LISTP NEW X,CNT
+1 SET X=""
SET CNT=0
KILL ECHOICE,ECSTOP
+2 DO HDR1^ECEDU
SET JJ=1
WRITE !,"Available Procedures within "_ECDN_": ",!
+3 WRITE ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
+4 SET EC1=1
+5 FOR
SET CNT=$ORDER(^TMP("ECPRO",$JOB,CNT))
if 'CNT!$DATA(ECHOICE)
QUIT
if ($Y+5>IOSL)
DO SELC
if $DATA(ECHOICE)
QUIT
IF X=""
WRITE !,CNT_".",?5,$EXTRACT($PIECE(^TMP("ECPRO",$JOB,CNT),"^",4),1,30),?38,$EXTRACT($PIECE(^(CNT),"^",3),1,30),?72,$PIECE(^(CNT),"^",5)
+6 IF X=""
Begin DoDot:1
+7 WRITE !!?5,"Select by number, CPT or national code, procedure name, or synonym."
+8 WRITE !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
+9 WRITE ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
End DoDot:1
+10 QUIT
+11 ;
FILE ;file pro
+1 DO HDR^ECEDU
+2 DO ^ECEDF
+3 QUIT
SETP ;set proc info
+1 SET ECJJ=0
+2 SET ECP=$PIECE(^TMP("ECPRO",$JOB,CNT),"^")
SET ECPN=$PIECE(^(CNT),"^",4)
SET NATN=$PIECE(^(CNT),"^",5)
SET ECVOL=$PIECE(^(CNT),"^",6)
SET SYN=$PIECE(^(CNT),"^",3)
SET EC4=$PIECE(^(CNT),"^",2)
+3 SET ECCPT=$SELECT(ECP["EC":$PIECE($GET(^EC(725,+ECP,0)),"^",5),1:+ECP)
+4 SET ECPTCD=""
IF ECCPT'=""
Begin DoDot:1
+5 SET ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT)
+6 IF +ECPTCD>0
SET ECPTCD=$PIECE(ECPTCD,U,2)
End DoDot:1
+7 WRITE " "_$SELECT(ECCPT="":"",1:ECPTCD_" ")_$EXTRACT(ECPN,1,50)
+8 WRITE $SELECT(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
+9 SET EC4=$PIECE($GET(^ECJ(+EC4,"PRO")),"^",4)
+10 SET EC4N=$SELECT($PIECE($GET(^SC(+EC4,0)),"^")]"":$PIECE(^(0),"^"),1:"")
SET ECID=$PIECE($GET(^SC(+EC4,0)),"^",7)
+11 SET ^TMP("ECLKUP",$JOB,"LAST")=CNT
+12 QUIT
SELC ; select category
+1 WRITE !!,$SELECT(EC1:"Press",1:"Select Number, or press")_" <RET> to continue listing "_$SELECT(EC1:"procedures",1:"categories")_" or '^' to stop: "
READ X:DTIME
IF '$TEST!(X="^")
SET (ECSTOP,ECHOICE)=1
QUIT
+2 IF X=""
WRITE @IOF,!,$SELECT(EC1:"Available Procedures",1:"Categories")_" within ",ECDN," : ",!
QUIT
+3 IF 'EC1
IF '$DATA(ECC(X))
DO MSGC^ECEDU
QUIT
+4 IF EC1
IF '$DATA(^TMP("ECPRO",$JOB,X))
DO MSGC^ECEDU
QUIT
+5 SET ECHOICE=1
+6 IF 'EC1
SET ECC=+$PIECE(ECC(X),"^")
SET ECCN=$PIECE(ECC(X),"^",2)
QUIT
+7 QUIT
