- ECBEN2A ;BIR/MAM,JPW-Categories and Procedures Selection ;30 Apr 96
- ;;2.0; EVENT CAPTURE ;**1,4,5,13,18,33,47,72**;8 May 96
- CHK ; check unit for valid categories
- S (COUNT,EC1)=0 K ECHOICE,ECSTOP
- D CATS^ECHECK1 S ECONE=""
- I '$D(ECC(1)) S ECC=0,ECCN="None",ECONE=0 G P
- I '$D(ECC(2)) S ECC=+ECC(1),ECCN=$P(ECC(1),"^",2),ECONE=1 G P
- CATS ; select category
- S X="",CNT=0
- LIST D HDR^ECBEN2U S JJ=0 W !,"Categories within "_ECDN_": ",!
- S EC1=0
- F 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) S ECONE=2 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 S CNT=CNT-5,X="" G LIST
- S ECHOICE=1,ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2),ECONE=2
- P ;check for valid procedures
- K ^TMP("ECLKUP",$J)
- 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
- D HDR^ECBEN2U
- P1 ;
- I '$D(^TMP("ECPRO",$J,2)) S CNT=1,ECONE=ECONE_"^1" D SETP W !,"Procedure: " D G V
- . W $S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
- . W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
- P2 ;ask mul proc
- S ECX="",(ECPCNT,CNT,OK)=0,EC1=1 K ECHOICE,ECSTOP,ECMOD
- S DIR("?")="^D PROS^ECBEN2A"
- S ECX=$$GETPRO^ECDSUTIL
- I +$G(ECX)=-1,(COUNT=0) D MSG^ECBEN2U,KILLV^ECDSUTIL Q
- I +$G(ECX)=-1,COUNT G FILE
- 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 V
- . S CNT=ECPCNT
- . D SETP
- . S OK=1,ECONE=ECONE_"^2"
- . D KILLV^ECDSUTIL
- I 'ECPCNT,$D(ECPNAME) S CNT=$$PRLST^ECDSUTIL
- I CNT=-1 D MSG^ECBEN2U,KILLV^ECDSUTIL Q
- I CNT>0 D G V
- . D SETP
- . S OK=1,ECONE=ECONE_"^2"
- . D KILLV^ECDSUTIL
- Q
- ;
- PROS ;
- S X="",CNT=0 K ECHOICE
- LISTP D HDR^ECBEN2U 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
- ;
- V ;vol (and procedure reason),ask for CPT modifier is applicable
- ;
- ;ALB/JAM - Ask CPT Procedure Modifier
- I ECCPT'="" D I ECOUT Q
- . S ECMODS=$G(ECMODS)
- . S ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR)
- . I $G(ECERR) S ECOUT=1
- . K ECMODF,ECMODS
- ;ALB/ESD - Ask Procedure Reason
- I $G(ECP)]"" S ECSCR=+$O(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
- K ECPRPTR
- I ECSCR>0,($P($G(^ECJ(ECSCR,"PRO")),"^",5)=1),(+$O(^ECL("AD",ECSCR,0))) D
- . S ECPRPTR=0
- . S DIC="^ECL(",DIC(0)="QEAM"
- . S DIC("A")="Procedure Reason: ",DIC("S")="I $P(^(0),U,2)=ECSCR"
- . D ^DIC K DIC
- . I +Y>0 S ECPRPTR=+Y
- K ECSCR
- ;
- VV ;vol
- S:'VOL VOL=1
- W !,"Volume: "_VOL_"// " R X:DTIME I '$T S ECOUT=1 Q
- I X="^" S ECOUT=1 Q
- S:X="" X=VOL I X'?1.2N!'X W !!,"Enter a whole number between 1 and 99." G VV
- S ECV=X
- CHKP ;
- W !!,"Category: ",?14,$E(ECCN,1,26),?44,"Ord Section: "_$E(ECON,1,22)
- W !,"Procedure: ",?14,$S(ECCPT="":"",1:ECPTCD_" ")_$E(ECPN,1,50)
- W $S(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")"
- I ECCPT'="" N MOD S MOD="" F S MOD=$O(ECMOD(ECCPT,MOD)) Q:MOD="" D
- . W !?1,"Modifier: ",?18,"- ",MOD," ",$E($P(ECMOD(ECCPT,MOD),U),1,55)
- ;
- ;ALB/ESD - Display procedure reason
- I +$G(ECPRPTR) S ECPRSL=$P($G(^ECL(+ECPRPTR,0)),"^") W !,"Procedure Reason: ",$P($G(^ECR(+ECPRSL,0)),"^")
- W !,"Date: ",?14,ECDATE,?44,"Volume: "_ECV
- W ! D DSP1444^ECPRVMUT(.ECPRVARY)
- W !!!,"Is this information correct ? YES// " R ECYN:DTIME I '$T!(ECYN="^") D NOTE S ECOUT=2,CNT=0 K ECEC W "Press <RET> to continue " R X:DTIME Q
- S ECYN=$E(ECYN) S:ECYN="" ECYN="Y"
- I "YyNn"'[ECYN W !!,"Enter <RET> if the information listed above is correct and should be",!,"entered for the patients selected. Enter NO to re-enter the information",!,"for this procedure.",!
- I "YyNn"'[ECYN W !!,"Press <RET> to continue " R X:DTIME G CHKP
- I "Nn"[ECYN,$P(ECONE,"^")<2,$P(ECONE,"^",2)<2 S ECOUT=2 Q
- I "Nn"[ECYN K ECHOICE,ECCN,ECP,ECPN,ECONE,ECMOD,^TMP("ECPRO",$J) G CHK
- ;
- ;ALB/ESD - File procedure reason in local array ECEC (used in ECBENF)
- S COUNT=COUNT+1,ECEC(COUNT)=ECC_"^"_ECP_"^^"_ECO_"^"_ECV_"^^^^^^"_ECCPT_$S(+$G(ECPRPTR):"^"_ECPRPTR,1:"")
- ;File CPT modifiers in array ECEC if they exist
- I ECCPT'="",$O(ECMOD(ECCPT,""))'="" D
- . M ECEC(COUNT,"MOD")=ECMOD(ECCPT)
- I $D(^TMP("ECPRO",$J,2)) W !! G P2
- FILE ;file proc
- I '$D(ECEC(1)) W !!,"No procedures have been selected for filing. Please re-enter the ",!,"information for the procedures, or ^ to exit.",!!,"Press <RET> to continue" R X:DTIME S:X="^" ECOUT=1 K ECTEMP,^TMP("ECPRO",$J) G P
- D ^ECBEN2B
- END Q
- SETP ;set proc
- S ECP=$P(^TMP("ECPRO",$J,CNT),"^"),ECPN=$P(^(CNT),"^",4),SYN=$P(^(CNT),"^",3),NATN=$P(^(CNT),"^",5),VOL=$P(^(CNT),"^",6)
- 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(^TMP("ECPRO",$J,CNT),"^",2)
- 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 MSG1^ECBEN2U Q
- I EC1,'$D(^TMP("ECPRO",$J,X)) D MSG1^ECBEN2U Q
- S ECHOICE=1
- I 'EC1 S ECC=$P(ECC(X),"^"),ECCN=$P(ECC(X),"^",2) Q
- Q
- NOTE ;
- W !!,"**NOTE** No action taken.",!,"You must re-enter the correct patient and procedure data that",!,"has NOT been filed during this session. ",!!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECBEN2A 6458 printed Feb 18, 2025@23:23:15 Page 2
- ECBEN2A ;BIR/MAM,JPW-Categories and Procedures Selection ;30 Apr 96
- +1 ;;2.0; EVENT CAPTURE ;**1,4,5,13,18,33,47,72**;8 May 96
- CHK ; check unit for valid categories
- +1 SET (COUNT,EC1)=0
- KILL ECHOICE,ECSTOP
- +2 DO CATS^ECHECK1
- SET ECONE=""
- +3 IF '$DATA(ECC(1))
- SET ECC=0
- SET ECCN="None"
- SET ECONE=0
- GOTO P
- +4 IF '$DATA(ECC(2))
- SET ECC=+ECC(1)
- SET ECCN=$PIECE(ECC(1),"^",2)
- SET ECONE=1
- GOTO P
- CATS ; select category
- +1 SET X=""
- SET CNT=0
- LIST DO HDR^ECBEN2U
- SET JJ=0
- WRITE !,"Categories within "_ECDN_": ",!
- +1 SET EC1=0
- +2 FOR
- 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)
- +3 IF '$DATA(ECSTOP)
- IF $DATA(ECHOICE)
- SET ECONE=2
- 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
- SET CNT=CNT-5
- SET X=""
- GOTO LIST
- +2 SET ECHOICE=1
- SET ECC=$PIECE(ECC(X),"^")
- SET ECCN=$PIECE(ECC(X),"^",2)
- SET ECONE=2
- P ;check for valid procedures
- +1 KILL ^TMP("ECLKUP",$JOB)
- +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
- +7 DO HDR^ECBEN2U
- P1 ;
- +1 IF '$DATA(^TMP("ECPRO",$JOB,2))
- SET CNT=1
- SET ECONE=ECONE_"^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 V
- P2 ;ask mul proc
- +1 SET ECX=""
- SET (ECPCNT,CNT,OK)=0
- SET EC1=1
- KILL ECHOICE,ECSTOP,ECMOD
- +2 SET DIR("?")="^D PROS^ECBEN2A"
- +3 SET ECX=$$GETPRO^ECDSUTIL
- +4 IF +$GET(ECX)=-1
- IF (COUNT=0)
- DO MSG^ECBEN2U
- DO KILLV^ECDSUTIL
- QUIT
- +5 IF +$GET(ECX)=-1
- IF COUNT
- GOTO FILE
- +6 IF +$GET(ECX)=1
- DO SRCHTM^ECDSUTIL(ECX)
- +7 SET ECPCNT=+$GET(ECPCNT)
- +8 IF ECPCNT=-1!(ECPCNT=-2)
- Begin DoDot:1
- +9 DO @($SELECT(ECPCNT=-1:"ERRMSG^ECDSUTIL",ECPCNT=-2:"ERRMSG2^ECDSUTIL"))
- +10 DO KILLV^ECDSUTIL
- End DoDot:1
- GOTO P2
- +11 IF ECPCNT>0
- Begin DoDot:1
- +12 SET CNT=ECPCNT
- +13 DO SETP
- +14 SET OK=1
- SET ECONE=ECONE_"^2"
- +15 DO KILLV^ECDSUTIL
- End DoDot:1
- GOTO V
- +16 IF 'ECPCNT
- IF $DATA(ECPNAME)
- SET CNT=$$PRLST^ECDSUTIL
- +17 IF CNT=-1
- DO MSG^ECBEN2U
- DO KILLV^ECDSUTIL
- QUIT
- +18 IF CNT>0
- Begin DoDot:1
- +19 DO SETP
- +20 SET OK=1
- SET ECONE=ECONE_"^2"
- +21 DO KILLV^ECDSUTIL
- End DoDot:1
- GOTO V
- +22 QUIT
- +23 ;
- PROS ;
- +1 SET X=""
- SET CNT=0
- KILL ECHOICE
- LISTP DO HDR^ECBEN2U
- SET JJ=1
- WRITE !,"Available Procedures within "_ECDN_": ",!
- +1 WRITE ?72,"National",!,?5,"Procedure Name",?40,"Synonym",?72,"Number",!
- +2 SET EC1=1
- +3 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)
- +4 IF X=""
- Begin DoDot:1
- +5 WRITE !!?5,"Select by number, CPT or national code, procedure name, or synonym."
- +6 WRITE !?5,"Synonym must be preceded by the & character (example: &TESTSYN).",!
- +7 WRITE ?2,"** Modifier(s) can be appended to a CPT code (ex: CPT code-mod1,mod2,mod3) **",!
- End DoDot:1
- +8 QUIT
- +9 ;
- V ;vol (and procedure reason),ask for CPT modifier is applicable
- +1 ;
- +2 ;ALB/JAM - Ask CPT Procedure Modifier
- +3 IF ECCPT'=""
- Begin DoDot:1
- +4 SET ECMODS=$GET(ECMODS)
- +5 SET ECMODF=$$ASKMOD^ECUTL(ECCPT,ECMODS,ECDT,.ECMOD,.ECERR)
- +6 IF $GET(ECERR)
- SET ECOUT=1
- +7 KILL ECMODF,ECMODS
- End DoDot:1
- IF ECOUT
- QUIT
- +8 ;ALB/ESD - Ask Procedure Reason
- +9 IF $GET(ECP)]""
- SET ECSCR=+$ORDER(^ECJ("AP",+ECL,+ECD,+ECC,ECP,0))
- +10 KILL ECPRPTR
- +11 IF ECSCR>0
- IF ($PIECE($GET(^ECJ(ECSCR,"PRO")),"^",5)=1)
- IF (+$ORDER(^ECL("AD",ECSCR,0)))
- Begin DoDot:1
- +12 SET ECPRPTR=0
- +13 SET DIC="^ECL("
- SET DIC(0)="QEAM"
- +14 SET DIC("A")="Procedure Reason: "
- SET DIC("S")="I $P(^(0),U,2)=ECSCR"
- +15 DO ^DIC
- KILL DIC
- +16 IF +Y>0
- SET ECPRPTR=+Y
- End DoDot:1
- +17 KILL ECSCR
- +18 ;
- VV ;vol
- +1 if 'VOL
- SET VOL=1
- +2 WRITE !,"Volume: "_VOL_"// "
- READ X:DTIME
- IF '$TEST
- SET ECOUT=1
- QUIT
- +3 IF X="^"
- SET ECOUT=1
- QUIT
- +4 if X=""
- SET X=VOL
- IF X'?1.2N!'X
- WRITE !!,"Enter a whole number between 1 and 99."
- GOTO VV
- +5 SET ECV=X
- CHKP ;
- +1 WRITE !!,"Category: ",?14,$EXTRACT(ECCN,1,26),?44,"Ord Section: "_$EXTRACT(ECON,1,22)
- +2 WRITE !,"Procedure: ",?14,$SELECT(ECCPT="":"",1:ECPTCD_" ")_$EXTRACT(ECPN,1,50)
- +3 WRITE $SELECT(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")"
- +4 IF ECCPT'=""
- NEW MOD
- SET MOD=""
- FOR
- SET MOD=$ORDER(ECMOD(ECCPT,MOD))
- if MOD=""
- QUIT
- Begin DoDot:1
- +5 WRITE !?1,"Modifier: ",?18,"- ",MOD," ",$EXTRACT($PIECE(ECMOD(ECCPT,MOD),U),1,55)
- End DoDot:1
- +6 ;
- +7 ;ALB/ESD - Display procedure reason
- +8 IF +$GET(ECPRPTR)
- SET ECPRSL=$PIECE($GET(^ECL(+ECPRPTR,0)),"^")
- WRITE !,"Procedure Reason: ",$PIECE($GET(^ECR(+ECPRSL,0)),"^")
- +9 WRITE !,"Date: ",?14,ECDATE,?44,"Volume: "_ECV
- +10 WRITE !
- DO DSP1444^ECPRVMUT(.ECPRVARY)
- +11 WRITE !!!,"Is this information correct ? YES// "
- READ ECYN:DTIME
- IF '$TEST!(ECYN="^")
- DO NOTE
- SET ECOUT=2
- SET CNT=0
- KILL ECEC
- WRITE "Press <RET> to continue "
- READ X:DTIME
- QUIT
- +12 SET ECYN=$EXTRACT(ECYN)
- if ECYN=""
- SET ECYN="Y"
- +13 IF "YyNn"'[ECYN
- WRITE !!,"Enter <RET> if the information listed above is correct and should be",!,"entered for the patients selected. Enter NO to re-enter the information",!,"for this procedure.",!
- +14 IF "YyNn"'[ECYN
- WRITE !!,"Press <RET> to continue "
- READ X:DTIME
- GOTO CHKP
- +15 IF "Nn"[ECYN
- IF $PIECE(ECONE,"^")<2
- IF $PIECE(ECONE,"^",2)<2
- SET ECOUT=2
- QUIT
- +16 IF "Nn"[ECYN
- KILL ECHOICE,ECCN,ECP,ECPN,ECONE,ECMOD,^TMP("ECPRO",$JOB)
- GOTO CHK
- +17 ;
- +18 ;ALB/ESD - File procedure reason in local array ECEC (used in ECBENF)
- +19 SET COUNT=COUNT+1
- SET ECEC(COUNT)=ECC_"^"_ECP_"^^"_ECO_"^"_ECV_"^^^^^^"_ECCPT_$SELECT(+$GET(ECPRPTR):"^"_ECPRPTR,1:"")
- +20 ;File CPT modifiers in array ECEC if they exist
- +21 IF ECCPT'=""
- IF $ORDER(ECMOD(ECCPT,""))'=""
- Begin DoDot:1
- +22 MERGE ECEC(COUNT,"MOD")=ECMOD(ECCPT)
- End DoDot:1
- +23 IF $DATA(^TMP("ECPRO",$JOB,2))
- WRITE !!
- GOTO P2
- FILE ;file proc
- +1 IF '$DATA(ECEC(1))
- WRITE !!,"No procedures have been selected for filing. Please re-enter the ",!,"information for the procedures, or ^ to exit.",!!,"Press <RET> to continue"
- READ X:DTIME
- if X="^"
- SET ECOUT=1
- KILL ECTEMP,^TMP("ECPRO",$JOB)
- GOTO P
- +2 DO ^ECBEN2B
- END QUIT
- SETP ;set proc
- +1 SET ECP=$PIECE(^TMP("ECPRO",$JOB,CNT),"^")
- SET ECPN=$PIECE(^(CNT),"^",4)
- SET SYN=$PIECE(^(CNT),"^",3)
- SET NATN=$PIECE(^(CNT),"^",5)
- SET VOL=$PIECE(^(CNT),"^",6)
- +2 SET ECCPT=$SELECT(ECP["EC":$PIECE($GET(^EC(725,+ECP,0)),"^",5),1:+ECP)
- +3 SET ECPTCD=""
- IF ECCPT'=""
- Begin DoDot:1
- +4 SET ECPTCD=$$CPT^ICPTCOD(ECCPT,ECDT)
- IF +ECPTCD>0
- SET ECPTCD=$PIECE(ECPTCD,U,2)
- End DoDot:1
- +5 WRITE " "_$SELECT(ECCPT="":"",1:ECPTCD_" ")_$EXTRACT(ECPN,1,50)
- +6 WRITE $SELECT(SYN'["NOT DEFINED":" ["_SYN_"]",1:"")_" (#"_NATN_")",!
- +7 SET EC4=$PIECE(^TMP("ECPRO",$JOB,CNT),"^",2)
- +8 SET ^TMP("ECLKUP",$JOB,"LAST")=CNT
- +9 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 MSG1^ECBEN2U
- QUIT
- +4 IF EC1
- IF '$DATA(^TMP("ECPRO",$JOB,X))
- DO MSG1^ECBEN2U
- QUIT
- +5 SET ECHOICE=1
- +6 IF 'EC1
- SET ECC=$PIECE(ECC(X),"^")
- SET ECCN=$PIECE(ECC(X),"^",2)
- QUIT
- +7 QUIT
- NOTE ;
- +1 WRITE !!,"**NOTE** No action taken.",!,"You must re-enter the correct patient and procedure data that",!,"has NOT been filed during this session. ",!!
- +2 QUIT