- ECDSUTIL ;BIR/RHK,TTH - Event Capture Utilities ;4 May 95
- ;;2.0; EVENT CAPTURE ;**4,5,7,14,18,29**;8 May 96
- ;Routine of various utilities and common subroutines
- UNIT ;Select DSS Unit
- I '$D(ECL) D ^ECL Q:'$D(ECL)
- S CNT=0 F XX=0:0 S XX=$O(^ECJ("AP",ECL,XX)) Q:'XX S CNT=CNT+1 S ECD=XX
- I CNT<2 D G SETVAR
- .S ECDN=$P(^ECD(ECD,0),"^") W !,"DSS Unit: ",ECDN
- .S Y=ECD_"^"_$P(^ECD(ECD,0),"^")
- .S Y(0)=^ECD(ECD,0)
- .Q
- S DIC=724,DIC(0)="AEQMZ",DIC("A")="Select DSS Unit: ",DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))" D ^DIC K DIC I Y<0 K ECL Q
- S ECD=+Y,ECDN=$P(Y,U,2)
- SETVAR ;Set variable from the selected DSS Unit.
- S ECD(0)=Y(0),ECS=$P(Y(0),U,2),ECMS=$P(Y(0),U,3),ECOST=$P(Y(0),U,4),ECSN=$P(^DIC(49,ECS,0),U)
- S ECPCE="U~"_$S($P(ECD(0),U,14)]"":$P(ECD(0),"^",14),1:"N")
- I $P(^ECD(ECD,0),U,11) D I $D(ECERR) K ECL,ECD,ECS,ECMS,ECOST,ECSN Q
- .S DIC=726,DIC(0)="AEQMZ",DIC("A")="Select Category: ",DIC("S")="I $D(^ECJ(""AP"",ECL,ECD,+Y))&('$P(^EC(726,+Y,0),U,3)!($P(^EC(726,+Y,0),U,3)>DT))"
- .D ^DIC K DIC I Y<0 S ECERR=1 Q
- .S ECC=+Y,ECCN=Y(0,0)
- I '$D(ECC) S ECC=0,ECCN="None"
- Q
- ;
- ;
- ;ALB/ESD - Procedure Reason utilities
- ;
- ADREAS(ECSPTR) ; Add procedure reason(s) to the EC Procedure Reason (#720.4)
- ; file and pointers to the EC Event Code Screens/Proc Reason
- ; Link (#720.5) file
- ;
- N DA,DIC,DLAYGO,DIE,DR,ECPRPTR,X,Y,DUOUT,DTOUT
- ASK S ECSPTR=+$G(ECSPTR)
- I 'ECSPTR G ADREASQ
- S DIC="^ECR(",DIC(0)="QEALZ",DLAYGO=720.4,DIC("A")="Enter procedure reason: "
- D ^DIC
- Q:Y=-1 Q:($D(DUOUT)!$D(DTOUT))
- I +Y>0 D
- . S ECPRPTR=+Y
- . S DIE=DIC,DA=ECPRPTR,DR=".02////1" D ^DIE
- . K DA,DIC,DLAYGO,DIE,Y
- . I '$D(^ECL("AC",ECPRPTR,ECSPTR)) D
- .. S DIC="^ECL(",DIC(0)="L",DLAYGO=720.5,X=ECPRPTR,DIC("DR")=".02////"_ECSPTR
- .. K DD,DO D FILE^DICN
- G ASK
- ADREASQ Q
- ;
- ;
- GETSCRN(ECPPTR) ; Get EC Event Code Screens (#720.3) file internal entry number
- ; (IEN)
- ;
- ; Input: ECPPTR = Event Capture Patient (#721) file IEN
- ;
- ; Output: EC Event Code Screens IEN if found or zero if not
- ;
- I '$G(ECPPTR) G GETSCRNQ
- N ECSIEN,ECNODE0
- S ECSIEN=0,ECNODE0=""
- ;
- ;- Get EC Patient record zero node
- S ECNODE0=$G(^ECH(+ECPPTR,0))
- I ECNODE0="" G GETSCRNQ
- ;
- ;- Get EC Screen IEN from file #720.3 "AP" xref using Loc, DSS Unit,
- ; Category, and Procedure from EC Patient record
- S ECSIEN=+$O(^ECJ("AP",+$P(ECNODE0,U,4),+$P(ECNODE0,U,7),+$P(ECNODE0,U,8),$P(ECNODE0,U,9),0))
- I 'ECSIEN G GETSCRNQ
- ;
- ;- If 'Ask Procedure Reasons?' field = Yes and one or more procedure
- ; reasons entered for the event code screen
- S ECSIEN=$S((+$P($G(^ECJ(ECSIEN,"PRO")),U,5))&(+$O(^ECL("AD",ECSIEN,0))):ECSIEN,1:0)
- GETSCRNQ Q +$G(ECSIEN)
- ;
- ;
- GETPRO() ;Get procedure from user and determine type
- ; Input: None
- ; Output: 1^type of procedure: X = procedure number
- ; N = CPT or national number
- ; A = name of procedure
- ; S = procedure synonym
- ; or -1 if unsuccessful
- ;
- ; ECPROCED = value of Y from DIR call
- ; ECMODS = value of CPT modifiers separated by comman
- ;
- N ECANS,Y
- K ECMODS S ECMODS="",ECANS=-1
- S DIR(0)="FAO",DIR("A")="Enter Procedure: "
- D ^DIR
- I $D(DIRUT)!($D(DUOUT))!($D(DTOUT))!(Y="") G GETPROQ
- I $G(Y)]"" D
- . S ECANS=$S($P(Y,"-")?1.4N:"X",($L($P(Y,"-"))=5)&(($P(Y,"-")?5N)!($P(Y,"-")?1A4AN)):"N",((Y?1A.ANP)&($E(Y,1)'="&")):"A",(Y?1"&".ANP):"S",($A(Y)=32):"L",(($L(Y)>5)&(Y?1N.ANP)):"A",1:"ERR")
- . ;S ECANS=$S(Y?1.4N:"X",($L(Y)=5)&((Y?5N)!(Y?1A4AN)):"N",((Y?1A.ANP)&($E(Y,1)'="&")):"A",(Y?1"&".ANP):"S",($A(Y)=32):"L",(($L(Y)>5)&(Y?1N.ANP)):"A",1:"ERR")
- . I ECANS'="ERR" D
- .. I "X^N^"[ECANS S ECMODS=$P(Y,"-",2),Y=$P(Y,"-")
- .. S ECMODS=$TR(ECMODS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- .. S ECANS=1_"^"_ECANS
- .. S ECPROCED=Y I $E(ECPROCED,1)="&" S ECPROCED=$E(ECPROCED,2,$L(ECPROCED))
- . I ECANS="ERR" S ECANS=-1
- ;
- GETPROQ K DIR,DIRUT,DTOUT,DUOUT
- Q $G(ECANS)
- ;
- ;
- SRCHTM(ANS) ; Lookup for procedures in ^TMP("ECPRO",$J)
- ; Input: Procedure type (see first output in GETPRO function above)
- ; Output: ECPCNT: -1 = no (or bad) procedure type
- ; 0 = procedure is in local ECPNAME array
- ; (for A and S types)
- ; number = procedure number (for X and N types)
- ;
- ; ECPNAME = procedure number^procedure name
- ; (for A and S types)
- ;
- N ECNOGO,ECPNAM,ECPUNAM,I,J
- S ECPCNT=-1,ECPNAM="",J=0
- I +ANS=-1!($G(ANS)="") G SRCHTMQ
- I +ANS=1,('$D(ECPROCED)) S ANS=-1 G SRCHTMQ
- ;
- ;-- Get 2nd piece of procedure type (letter) for lookup
- S ANS=$P(ANS,"^",2)
- ;
- ;-- Convert to upper case to handle case sensitivity
- S ECPROCED=$$UPPER^VALM1(ECPROCED)
- ;
- ;-- X = procedure number
- I ANS="X",$D(^TMP("ECPRO",$J,ECPROCED)) S ECPCNT=ECPROCED G SRCHTMQ
- ;
- ;-- N = CPT or national number
- I ANS="N",(+$O(^TMP("ECPRO",$J,"N",ECPROCED,0))>0) S ECPCNT=+$O(^TMP("ECPRO",$J,"N",ECPROCED,0)) G SRCHTMQ
- ;
- ;-- If "N" and not in National # xref, chk to see if it's a proc name
- I ANS="N",(+$O(^TMP("ECPRO",$J,"N",ECPROCED,0))=0) S ANS="A"
- ;
- ;-- L = last procedure (spacebar/return functionality)
- I ANS="L",$D(^TMP("ECLKUP",$J,"LAST")) S ECPCNT=+$P($G(^TMP("ECLKUP",$J,"LAST")),"^") G SRCHTMQ
- ;
- ;-- A = name of procedure / S = procedure synonym
- I ANS="A"!(ANS="S") D
- . F S ECPNAM=$O(^TMP("ECPRO",$J,$S(ANS="A":"B",ANS="S":"SYN"),ECPNAM)) Q:ECPNAM="" D
- .. S ECNOGO=0
- .. S ECPUNAM=$$UPPER^VALM1(ECPNAM)
- .. F I=1:1:$L(ECPROCED) S:$E(ECPROCED,I)'=$E(ECPUNAM,I) ECNOGO=1
- .. I 'ECNOGO S J=J+1,ECPCNT=0,ECPNAME(J)=+$O(^TMP("ECPRO",$J,$S(ANS="A":"B",ANS="S":"SYN"),ECPNAM,0))_"^"_ECPNAM
- I ANS="L",'$D(^TMP("ECLKUP",$J,"LAST")) S ECPCNT=-2
- SRCHTMQ Q
- ;
- ;
- PRLST() ;Print list if more than one procedure matches
- ;
- N ECFL,ECRESP,ECMAX,I
- S (ECFL,ECRESP,ECMAX,I)=0
- G:'$D(ECPNAME) PRLSTQ
- F S I=$O(ECPNAME(I)) Q:'I!(ECFL) D
- . I '$D(ECPNAME(2)) S (ECFL,ECRESP)=1 Q
- . W !?5,I,?10,$P(ECPNAME(I),"^",2) S ECMAX=I
- G:ECFL PRLSTQ
- CHOOSE S ECRESP=0
- W !!,"CHOOSE 1-"_ECMAX_": " R ECRESP:DTIME I '$T!(ECRESP["^") G PRLSTQ
- I +ECRESP<1!(+ECRESP>ECMAX) W *7,"??" G CHOOSE
- PRLSTQ Q $S(ECRESP>0:+$P(ECPNAME(ECRESP),"^"),1:-1)
- ;
- ;
- ;
- ERRMSG ;Invalid procedure error message
- ;
- W !!,"Enter a valid procedure or press ""^"" to exit.",!
- Q
- ;
- ;
- ERRMSG2 ;Spacebar/return error message
- ;
- W !!?5,"One procedure must be entered before using spacebar/return",!?5,"to get the same procedure.",!
- Q
- ;
- ;
- KILLV ;
- K ECPCNT,ECPNAME,ECPROCED,ECPROS,ECX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECDSUTIL 6729 printed Jan 18, 2025@02:58:29 Page 2
- ECDSUTIL ;BIR/RHK,TTH - Event Capture Utilities ;4 May 95
- +1 ;;2.0; EVENT CAPTURE ;**4,5,7,14,18,29**;8 May 96
- +2 ;Routine of various utilities and common subroutines
- UNIT ;Select DSS Unit
- +1 IF '$DATA(ECL)
- DO ^ECL
- if '$DATA(ECL)
- QUIT
- +2 SET CNT=0
- FOR XX=0:0
- SET XX=$ORDER(^ECJ("AP",ECL,XX))
- if 'XX
- QUIT
- SET CNT=CNT+1
- SET ECD=XX
- +3 IF CNT<2
- Begin DoDot:1
- +4 SET ECDN=$PIECE(^ECD(ECD,0),"^")
- WRITE !,"DSS Unit: ",ECDN
- +5 SET Y=ECD_"^"_$PIECE(^ECD(ECD,0),"^")
- +6 SET Y(0)=^ECD(ECD,0)
- +7 QUIT
- End DoDot:1
- GOTO SETVAR
- +8 SET DIC=724
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select DSS Unit: "
- SET DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))"
- DO ^DIC
- KILL DIC
- IF Y<0
- KILL ECL
- QUIT
- +9 SET ECD=+Y
- SET ECDN=$PIECE(Y,U,2)
- SETVAR ;Set variable from the selected DSS Unit.
- +1 SET ECD(0)=Y(0)
- SET ECS=$PIECE(Y(0),U,2)
- SET ECMS=$PIECE(Y(0),U,3)
- SET ECOST=$PIECE(Y(0),U,4)
- SET ECSN=$PIECE(^DIC(49,ECS,0),U)
- +2 SET ECPCE="U~"_$SELECT($PIECE(ECD(0),U,14)]"":$PIECE(ECD(0),"^",14),1:"N")
- +3 IF $PIECE(^ECD(ECD,0),U,11)
- Begin DoDot:1
- +4 SET DIC=726
- SET DIC(0)="AEQMZ"
- SET DIC("A")="Select Category: "
- SET DIC("S")="I $D(^ECJ(""AP"",ECL,ECD,+Y))&('$P(^EC(726,+Y,0),U,3)!($P(^EC(726,+Y,0),U,3)>DT))"
- +5 DO ^DIC
- KILL DIC
- IF Y<0
- SET ECERR=1
- QUIT
- +6 SET ECC=+Y
- SET ECCN=Y(0,0)
- End DoDot:1
- IF $DATA(ECERR)
- KILL ECL,ECD,ECS,ECMS,ECOST,ECSN
- QUIT
- +7 IF '$DATA(ECC)
- SET ECC=0
- SET ECCN="None"
- +8 QUIT
- +9 ;
- +10 ;
- +11 ;ALB/ESD - Procedure Reason utilities
- +12 ;
- ADREAS(ECSPTR) ; Add procedure reason(s) to the EC Procedure Reason (#720.4)
- +1 ; file and pointers to the EC Event Code Screens/Proc Reason
- +2 ; Link (#720.5) file
- +3 ;
- +4 NEW DA,DIC,DLAYGO,DIE,DR,ECPRPTR,X,Y,DUOUT,DTOUT
- ASK SET ECSPTR=+$GET(ECSPTR)
- +1 IF 'ECSPTR
- GOTO ADREASQ
- +2 SET DIC="^ECR("
- SET DIC(0)="QEALZ"
- SET DLAYGO=720.4
- SET DIC("A")="Enter procedure reason: "
- +3 DO ^DIC
- +4 if Y=-1
- QUIT
- if ($DATA(DUOUT)!$DATA(DTOUT))
- QUIT
- +5 IF +Y>0
- Begin DoDot:1
- +6 SET ECPRPTR=+Y
- +7 SET DIE=DIC
- SET DA=ECPRPTR
- SET DR=".02////1"
- DO ^DIE
- +8 KILL DA,DIC,DLAYGO,DIE,Y
- +9 IF '$DATA(^ECL("AC",ECPRPTR,ECSPTR))
- Begin DoDot:2
- +10 SET DIC="^ECL("
- SET DIC(0)="L"
- SET DLAYGO=720.5
- SET X=ECPRPTR
- SET DIC("DR")=".02////"_ECSPTR
- +11 KILL DD,DO
- DO FILE^DICN
- End DoDot:2
- End DoDot:1
- +12 GOTO ASK
- ADREASQ QUIT
- +1 ;
- +2 ;
- GETSCRN(ECPPTR) ; Get EC Event Code Screens (#720.3) file internal entry number
- +1 ; (IEN)
- +2 ;
- +3 ; Input: ECPPTR = Event Capture Patient (#721) file IEN
- +4 ;
- +5 ; Output: EC Event Code Screens IEN if found or zero if not
- +6 ;
- +7 IF '$GET(ECPPTR)
- GOTO GETSCRNQ
- +8 NEW ECSIEN,ECNODE0
- +9 SET ECSIEN=0
- SET ECNODE0=""
- +10 ;
- +11 ;- Get EC Patient record zero node
- +12 SET ECNODE0=$GET(^ECH(+ECPPTR,0))
- +13 IF ECNODE0=""
- GOTO GETSCRNQ
- +14 ;
- +15 ;- Get EC Screen IEN from file #720.3 "AP" xref using Loc, DSS Unit,
- +16 ; Category, and Procedure from EC Patient record
- +17 SET ECSIEN=+$ORDER(^ECJ("AP",+$PIECE(ECNODE0,U,4),+$PIECE(ECNODE0,U,7),+$PIECE(ECNODE0,U,8),$PIECE(ECNODE0,U,9),0))
- +18 IF 'ECSIEN
- GOTO GETSCRNQ
- +19 ;
- +20 ;- If 'Ask Procedure Reasons?' field = Yes and one or more procedure
- +21 ; reasons entered for the event code screen
- +22 SET ECSIEN=$SELECT((+$PIECE($GET(^ECJ(ECSIEN,"PRO")),U,5))&(+$ORDER(^ECL("AD",ECSIEN,0))):ECSIEN,1:0)
- GETSCRNQ QUIT +$GET(ECSIEN)
- +1 ;
- +2 ;
- GETPRO() ;Get procedure from user and determine type
- +1 ; Input: None
- +2 ; Output: 1^type of procedure: X = procedure number
- +3 ; N = CPT or national number
- +4 ; A = name of procedure
- +5 ; S = procedure synonym
- +6 ; or -1 if unsuccessful
- +7 ;
- +8 ; ECPROCED = value of Y from DIR call
- +9 ; ECMODS = value of CPT modifiers separated by comman
- +10 ;
- +11 NEW ECANS,Y
- +12 KILL ECMODS
- SET ECMODS=""
- SET ECANS=-1
- +13 SET DIR(0)="FAO"
- SET DIR("A")="Enter Procedure: "
- +14 DO ^DIR
- +15 IF $DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT))!(Y="")
- GOTO GETPROQ
- +16 IF $GET(Y)]""
- Begin DoDot:1
- +17 SET ECANS=$SELECT($PIECE(Y,"-")?1.4N:"X",($LENGTH($PIECE(Y,"-"))=5)&(($PIECE(Y,"-")?5N)!($PIECE(Y,"-")?1A4AN)):"N",((Y?1A.ANP)&($EXTRACT(Y,1)'="&")):"A",(Y?1"&".ANP):"S",($ASCII(Y)=32):"L",(($LENGTH(Y)>5)&(Y?1N.ANP)):"A",1:"ERR")
- +18 ;S ECANS=$S(Y?1.4N:"X",($L(Y)=5)&((Y?5N)!(Y?1A4AN)):"N",((Y?1A.ANP)&($E(Y,1)'="&")):"A",(Y?1"&".ANP):"S",($A(Y)=32):"L",(($L(Y)>5)&(Y?1N.ANP)):"A",1:"ERR")
- +19 IF ECANS'="ERR"
- Begin DoDot:2
- +20 IF "X^N^"[ECANS
- SET ECMODS=$PIECE(Y,"-",2)
- SET Y=$PIECE(Y,"-")
- +21 SET ECMODS=$TRANSLATE(ECMODS,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +22 SET ECANS=1_"^"_ECANS
- +23 SET ECPROCED=Y
- IF $EXTRACT(ECPROCED,1)="&"
- SET ECPROCED=$EXTRACT(ECPROCED,2,$LENGTH(ECPROCED))
- End DoDot:2
- +24 IF ECANS="ERR"
- SET ECANS=-1
- End DoDot:1
- +25 ;
- GETPROQ KILL DIR,DIRUT,DTOUT,DUOUT
- +1 QUIT $GET(ECANS)
- +2 ;
- +3 ;
- SRCHTM(ANS) ; Lookup for procedures in ^TMP("ECPRO",$J)
- +1 ; Input: Procedure type (see first output in GETPRO function above)
- +2 ; Output: ECPCNT: -1 = no (or bad) procedure type
- +3 ; 0 = procedure is in local ECPNAME array
- +4 ; (for A and S types)
- +5 ; number = procedure number (for X and N types)
- +6 ;
- +7 ; ECPNAME = procedure number^procedure name
- +8 ; (for A and S types)
- +9 ;
- +10 NEW ECNOGO,ECPNAM,ECPUNAM,I,J
- +11 SET ECPCNT=-1
- SET ECPNAM=""
- SET J=0
- +12 IF +ANS=-1!($GET(ANS)="")
- GOTO SRCHTMQ
- +13 IF +ANS=1
- IF ('$DATA(ECPROCED))
- SET ANS=-1
- GOTO SRCHTMQ
- +14 ;
- +15 ;-- Get 2nd piece of procedure type (letter) for lookup
- +16 SET ANS=$PIECE(ANS,"^",2)
- +17 ;
- +18 ;-- Convert to upper case to handle case sensitivity
- +19 SET ECPROCED=$$UPPER^VALM1(ECPROCED)
- +20 ;
- +21 ;-- X = procedure number
- +22 IF ANS="X"
- IF $DATA(^TMP("ECPRO",$JOB,ECPROCED))
- SET ECPCNT=ECPROCED
- GOTO SRCHTMQ
- +23 ;
- +24 ;-- N = CPT or national number
- +25 IF ANS="N"
- IF (+$ORDER(^TMP("ECPRO",$JOB,"N",ECPROCED,0))>0)
- SET ECPCNT=+$ORDER(^TMP("ECPRO",$JOB,"N",ECPROCED,0))
- GOTO SRCHTMQ
- +26 ;
- +27 ;-- If "N" and not in National # xref, chk to see if it's a proc name
- +28 IF ANS="N"
- IF (+$ORDER(^TMP("ECPRO",$JOB,"N",ECPROCED,0))=0)
- SET ANS="A"
- +29 ;
- +30 ;-- L = last procedure (spacebar/return functionality)
- +31 IF ANS="L"
- IF $DATA(^TMP("ECLKUP",$JOB,"LAST"))
- SET ECPCNT=+$PIECE($GET(^TMP("ECLKUP",$JOB,"LAST")),"^")
- GOTO SRCHTMQ
- +32 ;
- +33 ;-- A = name of procedure / S = procedure synonym
- +34 IF ANS="A"!(ANS="S")
- Begin DoDot:1
- +35 FOR
- SET ECPNAM=$ORDER(^TMP("ECPRO",$JOB,$SELECT(ANS="A":"B",ANS="S":"SYN"),ECPNAM))
- if ECPNAM=""
- QUIT
- Begin DoDot:2
- +36 SET ECNOGO=0
- +37 SET ECPUNAM=$$UPPER^VALM1(ECPNAM)
- +38 FOR I=1:1:$LENGTH(ECPROCED)
- if $EXTRACT(ECPROCED,I)'=$EXTRACT(ECPUNAM,I)
- SET ECNOGO=1
- +39 IF 'ECNOGO
- SET J=J+1
- SET ECPCNT=0
- SET ECPNAME(J)=+$ORDER(^TMP("ECPRO",$JOB,$SELECT(ANS="A":"B",ANS="S":"SYN"),ECPNAM,0))_"^"_ECPNAM
- End DoDot:2
- End DoDot:1
- +40 IF ANS="L"
- IF '$DATA(^TMP("ECLKUP",$JOB,"LAST"))
- SET ECPCNT=-2
- SRCHTMQ QUIT
- +1 ;
- +2 ;
- PRLST() ;Print list if more than one procedure matches
- +1 ;
- +2 NEW ECFL,ECRESP,ECMAX,I
- +3 SET (ECFL,ECRESP,ECMAX,I)=0
- +4 if '$DATA(ECPNAME)
- GOTO PRLSTQ
- +5 FOR
- SET I=$ORDER(ECPNAME(I))
- if 'I!(ECFL)
- QUIT
- Begin DoDot:1
- +6 IF '$DATA(ECPNAME(2))
- SET (ECFL,ECRESP)=1
- QUIT
- +7 WRITE !?5,I,?10,$PIECE(ECPNAME(I),"^",2)
- SET ECMAX=I
- End DoDot:1
- +8 if ECFL
- GOTO PRLSTQ
- CHOOSE SET ECRESP=0
- +1 WRITE !!,"CHOOSE 1-"_ECMAX_": "
- READ ECRESP:DTIME
- IF '$TEST!(ECRESP["^")
- GOTO PRLSTQ
- +2 IF +ECRESP<1!(+ECRESP>ECMAX)
- WRITE *7,"??"
- GOTO CHOOSE
- PRLSTQ QUIT $SELECT(ECRESP>0:+$PIECE(ECPNAME(ECRESP),"^"),1:-1)
- +1 ;
- +2 ;
- +3 ;
- ERRMSG ;Invalid procedure error message
- +1 ;
- +2 WRITE !!,"Enter a valid procedure or press ""^"" to exit.",!
- +3 QUIT
- +4 ;
- +5 ;
- ERRMSG2 ;Spacebar/return error message
- +1 ;
- +2 WRITE !!?5,"One procedure must be entered before using spacebar/return",!?5,"to get the same procedure.",!
- +3 QUIT
- +4 ;
- +5 ;
- KILLV ;
- +1 KILL ECPCNT,ECPNAME,ECPROCED,ECPROS,ECX
- +2 QUIT