- TIUCNSLT ; SLC/JER - Patient movement look-up ;1/7/03 [6/11/04 8:34am]
- ;;1.0;TEXT INTEGRATION UTILITIES;**4,31,109,131,142,144,184**;Jun 20, 1997
- ; External References
- ; DBIA 2324 $$ISA^USRLM
- ; DBIA 3473 SEND^GMRCTIU
- ; DBIA 3473 GET^GMRCTIU
- ; DBIA 3575 ROLLBACK^GMRCTIU1
- GETCNSLT(DFN,TIUCPF,TIUDA,TIUOVR) ; Match consult result
- ;to an active request
- ; Call with:
- ; [DFN] - patient file entry number
- ; [TIUCPF] - flag to indicate clinical procedure (Optional)
- ; [TIUDA] - TIU document IEN of consult result (Optional).
- ; If TIUDA has a request, return it w/o asking user.
- ; [TIUOVR] - flag to override restrictions on selectable requests
- ; (Optional). If not received or received as null, reset
- ; according to whether user is in MIS.
- ; Note - If DA is defined and TIU document DA has a request,
- ; code returns its request instead of asking user.
- ; Returns: TIUY - Variable pointer to consult request
- ; = -1 if pat has no requests
- ; = 0 if no request is selected
- AGN ; Loop for handling repeated attempts
- N TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUY,TIUCNT,X
- I +DFN'>0 S TIUOUT=1 Q 0
- I +$G(GMRCO) S TIUX=+$G(GMRCO) G GETX
- ; -- If TIUDA is not defined, try DA for backward
- ; compatibility:
- S TIUDA=$S('$D(TIUDA):+$G(DA),1:+TIUDA)
- ; -- Ignore TIUDA if it doesn't match pt DFN:
- I $P($G(^TIU(8925,TIUDA,0)),U,2)'=+DFN S TIUDA=0
- ; -- If TIUDA or its parent already has a request,
- ; return it & don't ask user:
- I +$P($G(^TIU(8925,TIUDA,14)),U,5) S TIUX=+$P($G(^(14)),U,5) G GETX
- I +$$ISADDNDM^TIULC1(TIUDA) S TIUX=+$$DADCR(TIUDA) G:+TIUX>0 GETX
- ; -- If override flag is null or is not defined, set it according to
- ; user's membership in MIS:
- S TIUOVR=$S($G(TIUOVR)="":+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION"),1:+TIUOVR)
- D SEND^GMRCTIU(DFN,$G(TIUOVR),$G(TIUCPF))
- ; If no consult requests for patient, then quit with -1
- I $S($G(^TMP("GMRCR",$J,"TIU",1,0))["No Consults":1,'$D(^TMP("GMRCR",$J,"TIU")):1,1:0) D Q -1
- . W !!,$C(7),"No CONSULT REQUESTS to Result for ",$P($G(^DPT(DFN,0)),U),".",!
- S (TIUCNT,TIUI)=0 F S TIUI=+$O(^TMP("GMRCR",$J,"TIU",TIUI)) Q:+TIUI'>0 D
- . S TIUCNT=+$G(TIUCNT)+1
- W !,"You must link this Result to a Consult Request...",!
- D I +TIUER Q:+$G(TIUOUT) 0 G AGN
- . W !,"The following CONSULT REQUEST"
- . W $S(+TIUCNT>1:"(S) are",1:" is")," available:"
- . S (TIUER,TIUOK,TIUI)=0
- . F S TIUI=$O(^TMP("GMRCR",$J,"TIU",TIUI)) Q:+TIUI'>0!+TIUER!+TIUOK D
- . . S TIUII=TIUI,TIUX=$G(^TMP("GMRCR",$J,"TIU",TIUI,0))
- . . D WRITE I '(TIUI#5) D BREAK
- . Q:$D(TIUOUT)
- . I +TIUER S TIUOUT=1 Q
- . I TIUII#5 D BREAK Q:$D(TIUOUT)
- . I +TIUER S TIUOUT=1 Q
- . S TIUX=$O(^TMP("GMRCR",$J,"TIU","B",+TIUOK,0))
- . ;,^DISV(DUZ,"^GMR(123,",DFN)=+TIUX
- . W " ",+TIUX
- GETX S TIUY=+TIUX_";GMR(123,"
- Q $G(TIUY)
- BREAK ; Handle prompting
- W !,"CHOOSE 1-",TIUII W:$D(^TMP("GMRCR",$J,"TIU",TIUII+1,0)) !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT" W ": " R X:DTIME
- I $S('$T!(X["^"):1,X=""&'$D(^TMP("GMRCR",$J,"TIU",TIUII+1)):1,1:0) S TIUER=1 Q
- I X="" Q
- I X'=+X!'$D(^TMP("GMRCR",$J,"TIU",+X)) W !!,$C(7),"INVALID RESPONSE",! G BREAK
- S TIUOK=X
- Q
- DADCR(DA) ; Get the Consult request associated with the parent record
- N TIUDADA,TIUY S TIUDADA=$P($G(^TIU(8925,+DA,0)),U,6)
- S TIUY=$P($G(^TIU(8925,TIUDADA,14)),U,5)
- Q TIUY
- WRITE W !,TIUX
- Q
- POST(TIUDA,STATUS) ; Post status updates to Consult Tracking
- N GMRCDA,DA,TIUAUTH S GMRCDA=+$P($G(^TIU(8925,+TIUDA,14)),U,5)
- I +GMRCDA'>0 Q
- S TIUAUTH=$P($G(^TIU(8925,TIUDA,12)),U,2)
- D GET^GMRCTIU(GMRCDA,TIUDA,STATUS,TIUAUTH)
- Q
- ISCNSLT(TIUY,TITLE) ; Boolean RPC to evaluate whether TITLE is a CONSULT
- N TIUCLASS
- S TIUCLASS=+$$CLASS
- I +TIUCLASS'>0 S TIUY=0 Q
- S TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
- Q
- CHANGE(TIUDA,TIUCPF,TIUNOCS) ; Re-direct the TIU Document to a different CT Record
- ; Passes back TIUNOCS=-1 if pt has no requests or none is selected
- N DA,DFN,DIE,DR,GMRCO,GMRCSTAT,GMRCVP,TIUD0,TIUD14
- S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD14=$G(^(14))
- S DFN=$P(TIUD0,U,2),GMRCO=$P(TIUD14,U,5)
- Q:+DFN'>0
- I GMRCO'="" D ROLLBACK(TIUDA) K GMRCO ;P144
- CHAGN S DA=TIUDA,TIUNOCS=0
- W ! S GMRCVP=+$$GETCNSLT(DFN,$G(TIUCPF))_";GMR(123,"
- I +GMRCVP=0 W !!,$C(7),"You must select a Consult Request...Restoring record."
- I +GMRCVP'>0 D RETREAT(TIUDA,TIUD14) S TIUPOP=1,TIUNOCS=-1 Q ;P144
- S DIE=8925,DA=TIUDA,DR="1405////^S X=GMRCVP" D ^DIE
- D UPDTADD(TIUDA,GMRCVP)
- S GMRCO=+GMRCVP,GMRCSTAT=$S($P(TIUD0,U,5)>6:"COMPLETED",1:"INCOMPLETE")
- D POST(TIUDA,GMRCSTAT)
- Q
- RETREAT(DA,TIUD14) ; If Pt has no requests, retreat gracefully
- N DIE,DR,GMRCO,GMRCSTAT
- S DIE=8925,DR="1405////^S X=$P(TIUD14,U,5)" D ^DIE
- S GMRCO=+$P(TIUD14,U,5)
- S GMRCSTAT=$S($P(TIUD0,U,5)>6:"COMPLETED",1:"INCOMPLETE")
- D POST(TIUDA,GMRCSTAT)
- Q
- UPDTADD(TIUDA,TIUCVP) ; Addenda for re-linked original are updated
- ;Update TIU(8925 ONLY. GMR(123 doesn't track individual adda
- I $$HASADDEN^TIULC1(+TIUDA) D
- . N DA
- . S DA=0 F S DA=$O(^TIU(8925,"DAD",+TIUDA,DA)) Q:+DA'>0 D
- . . N DR,DIE
- . . I '+$$ISADDNDM^TIULC1(+DA) Q
- . . S DR="1405////^S X=TIUCVP"
- . . S DIE=8925 D ^DIE
- . . D ^DIE
- Q
- ROLLBACK(TIUDA) ; Roll back CT Record when TIU changes require it
- N GMRCDA,DIE,DR,DA S GMRCDA=+$P($G(^TIU(8925,TIUDA,14)),U,5)
- I +GMRCDA>0 D ROLLBACK^GMRCTIU1(GMRCDA,TIUDA) ;P144
- S DIE="^TIU(8925,",DA=TIUDA,DR="1405///@" D ^DIE
- Q
- CLASS() ; What is the TIU Class (or Document Class) for CONSULTS
- N GMRCY
- S GMRCY=+$O(^TIU(8925.1,"B","CONSULTS",0))
- I +GMRCY>0,$S($P($G(^TIU(8925.1,+GMRCY,0)),U,4)="CL":0,$P($G(^(0)),U,4)="DC":0,1:1) S GMRCY=0
- Q GMRCY
- REMCNSLT(TIUDA) ;Remove link to consult if there is one ;*171
- ;TIUDA is a TIU record number
- N TIUTYPE,TIUDELX
- S TIUTYPE=+$G(^TIU(8925,+TIUDA,0))
- S TIUDELX=$$DELETE^TIULC1(TIUTYPE)
- I TIUDELX]"" X TIUDELX
- Q
- CONSCT(TIUDA,TIUOTTL,TIUNTTL) ;
- ;non cons title to cons title - already handled
- ;cons title to cons title - already handled
- ;cons title to non cons title
- N TIUCLASS
- S TIUCLASS=$$CLASS^TIUCNSLT()
- I +$$ISA^TIULX(TIUOTTL,TIUCLASS),'+$$ISA^TIULX(TIUNTTL,TIUCLASS) D
- . W !,"The Title you selected is not a Consults Title."
- . W !," The note is currently linked to a Consults Request,"
- . W !," but will be disassociated when the title is changed"
- . W !," to a non Consults Title.",!
- . W !,"Do you want to continue with this Change Title Action?"
- . I +$$READ^TIUU("YO",,"N")'>0 S TIUQUIT=1
- . I $G(TIUQUIT)=1 W !,"Title not changed." Q
- . D REMCNSLT(+TIUDA)
- Q
- CNSCTGUI(TIUDA,TIUOTTL,TIUNTTL) ;
- ;non cons title to cons title - already handled
- ;cons title to cons title - already handled
- ;cons title to non cons title
- N TIUCLASS
- S TIUCLASS=$$CLASS^TIUCNSLT()
- I +$$ISA^TIULX(TIUOTTL,TIUCLASS),'+$$ISA^TIULX(TIUNTTL,TIUCLASS) D
- . ;Assume the confirmation has been taken care of already
- . D REMCNSLT(+TIUDA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCNSLT 7021 printed Jan 18, 2025@03:40:27 Page 2
- TIUCNSLT ; SLC/JER - Patient movement look-up ;1/7/03 [6/11/04 8:34am]
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**4,31,109,131,142,144,184**;Jun 20, 1997
- +2 ; External References
- +3 ; DBIA 2324 $$ISA^USRLM
- +4 ; DBIA 3473 SEND^GMRCTIU
- +5 ; DBIA 3473 GET^GMRCTIU
- +6 ; DBIA 3575 ROLLBACK^GMRCTIU1
- GETCNSLT(DFN,TIUCPF,TIUDA,TIUOVR) ; Match consult result
- +1 ;to an active request
- +2 ; Call with:
- +3 ; [DFN] - patient file entry number
- +4 ; [TIUCPF] - flag to indicate clinical procedure (Optional)
- +5 ; [TIUDA] - TIU document IEN of consult result (Optional).
- +6 ; If TIUDA has a request, return it w/o asking user.
- +7 ; [TIUOVR] - flag to override restrictions on selectable requests
- +8 ; (Optional). If not received or received as null, reset
- +9 ; according to whether user is in MIS.
- +10 ; Note - If DA is defined and TIU document DA has a request,
- +11 ; code returns its request instead of asking user.
- +12 ; Returns: TIUY - Variable pointer to consult request
- +13 ; = -1 if pat has no requests
- +14 ; = 0 if no request is selected
- AGN ; Loop for handling repeated attempts
- +1 NEW TIUI,TIUII,TIUER,TIUOK,TIUOUT,TIUX,TIUY,TIUCNT,X
- +2 IF +DFN'>0
- SET TIUOUT=1
- QUIT 0
- +3 IF +$GET(GMRCO)
- SET TIUX=+$GET(GMRCO)
- GOTO GETX
- +4 ; -- If TIUDA is not defined, try DA for backward
- +5 ; compatibility:
- +6 SET TIUDA=$SELECT('$DATA(TIUDA):+$GET(DA),1:+TIUDA)
- +7 ; -- Ignore TIUDA if it doesn't match pt DFN:
- +8 IF $PIECE($GET(^TIU(8925,TIUDA,0)),U,2)'=+DFN
- SET TIUDA=0
- +9 ; -- If TIUDA or its parent already has a request,
- +10 ; return it & don't ask user:
- +11 IF +$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
- SET TIUX=+$PIECE($GET(^(14)),U,5)
- GOTO GETX
- +12 IF +$$ISADDNDM^TIULC1(TIUDA)
- SET TIUX=+$$DADCR(TIUDA)
- if +TIUX>0
- GOTO GETX
- +13 ; -- If override flag is null or is not defined, set it according to
- +14 ; user's membership in MIS:
- +15 SET TIUOVR=$SELECT($GET(TIUOVR)="":+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION"),1:+TIUOVR)
- +16 DO SEND^GMRCTIU(DFN,$GET(TIUOVR),$GET(TIUCPF))
- +17 ; If no consult requests for patient, then quit with -1
- +18 IF $SELECT($GET(^TMP("GMRCR",$JOB,"TIU",1,0))["No Consults":1,'$DATA(^TMP("GMRCR",$JOB,"TIU")):1,1:0)
- Begin DoDot:1
- +19 WRITE !!,$CHAR(7),"No CONSULT REQUESTS to Result for ",$PIECE($GET(^DPT(DFN,0)),U),".",!
- End DoDot:1
- QUIT -1
- +20 SET (TIUCNT,TIUI)=0
- FOR
- SET TIUI=+$ORDER(^TMP("GMRCR",$JOB,"TIU",TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +21 SET TIUCNT=+$GET(TIUCNT)+1
- End DoDot:1
- +22 WRITE !,"You must link this Result to a Consult Request...",!
- +23 Begin DoDot:1
- +24 WRITE !,"The following CONSULT REQUEST"
- +25 WRITE $SELECT(+TIUCNT>1:"(S) are",1:" is")," available:"
- +26 SET (TIUER,TIUOK,TIUI)=0
- +27 FOR
- SET TIUI=$ORDER(^TMP("GMRCR",$JOB,"TIU",TIUI))
- if +TIUI'>0!+TIUER!+TIUOK
- QUIT
- Begin DoDot:2
- +28 SET TIUII=TIUI
- SET TIUX=$GET(^TMP("GMRCR",$JOB,"TIU",TIUI,0))
- +29 DO WRITE
- IF '(TIUI#5)
- DO BREAK
- End DoDot:2
- +30 if $DATA(TIUOUT)
- QUIT
- +31 IF +TIUER
- SET TIUOUT=1
- QUIT
- +32 IF TIUII#5
- DO BREAK
- if $DATA(TIUOUT)
- QUIT
- +33 IF +TIUER
- SET TIUOUT=1
- QUIT
- +34 SET TIUX=$ORDER(^TMP("GMRCR",$JOB,"TIU","B",+TIUOK,0))
- +35 ;,^DISV(DUZ,"^GMR(123,",DFN)=+TIUX
- +36 WRITE " ",+TIUX
- End DoDot:1
- IF +TIUER
- if +$GET(TIUOUT)
- QUIT 0
- GOTO AGN
- GETX SET TIUY=+TIUX_";GMR(123,"
- +1 QUIT $GET(TIUY)
- BREAK ; Handle prompting
- +1 WRITE !,"CHOOSE 1-",TIUII
- if $DATA(^TMP("GMRCR",$JOB,"TIU",TIUII+1,0))
- WRITE !,"<RETURN> TO CONTINUE",!,"OR '^' TO QUIT"
- WRITE ": "
- READ X:DTIME
- +2 IF $SELECT('$TEST!(X["^"):1,X=""&'$DATA(^TMP("GMRCR",$JOB,"TIU",TIUII+1)):1,1:0)
- SET TIUER=1
- QUIT
- +3 IF X=""
- QUIT
- +4 IF X'=+X!'$DATA(^TMP("GMRCR",$JOB,"TIU",+X))
- WRITE !!,$CHAR(7),"INVALID RESPONSE",!
- GOTO BREAK
- +5 SET TIUOK=X
- +6 QUIT
- DADCR(DA) ; Get the Consult request associated with the parent record
- +1 NEW TIUDADA,TIUY
- SET TIUDADA=$PIECE($GET(^TIU(8925,+DA,0)),U,6)
- +2 SET TIUY=$PIECE($GET(^TIU(8925,TIUDADA,14)),U,5)
- +3 QUIT TIUY
- WRITE WRITE !,TIUX
- +1 QUIT
- POST(TIUDA,STATUS) ; Post status updates to Consult Tracking
- +1 NEW GMRCDA,DA,TIUAUTH
- SET GMRCDA=+$PIECE($GET(^TIU(8925,+TIUDA,14)),U,5)
- +2 IF +GMRCDA'>0
- QUIT
- +3 SET TIUAUTH=$PIECE($GET(^TIU(8925,TIUDA,12)),U,2)
- +4 DO GET^GMRCTIU(GMRCDA,TIUDA,STATUS,TIUAUTH)
- +5 QUIT
- ISCNSLT(TIUY,TITLE) ; Boolean RPC to evaluate whether TITLE is a CONSULT
- +1 NEW TIUCLASS
- +2 SET TIUCLASS=+$$CLASS
- +3 IF +TIUCLASS'>0
- SET TIUY=0
- QUIT
- +4 SET TIUY=+$$ISA^TIULX(TITLE,TIUCLASS)
- +5 QUIT
- CHANGE(TIUDA,TIUCPF,TIUNOCS) ; Re-direct the TIU Document to a different CT Record
- +1 ; Passes back TIUNOCS=-1 if pt has no requests or none is selected
- +2 NEW DA,DFN,DIE,DR,GMRCO,GMRCSTAT,GMRCVP,TIUD0,TIUD14
- +3 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
- SET TIUD14=$GET(^(14))
- +4 SET DFN=$PIECE(TIUD0,U,2)
- SET GMRCO=$PIECE(TIUD14,U,5)
- +5 if +DFN'>0
- QUIT
- +6 ;P144
- IF GMRCO'=""
- DO ROLLBACK(TIUDA)
- KILL GMRCO
- CHAGN SET DA=TIUDA
- SET TIUNOCS=0
- +1 WRITE !
- SET GMRCVP=+$$GETCNSLT(DFN,$GET(TIUCPF))_";GMR(123,"
- +2 IF +GMRCVP=0
- WRITE !!,$CHAR(7),"You must select a Consult Request...Restoring record."
- +3 ;P144
- IF +GMRCVP'>0
- DO RETREAT(TIUDA,TIUD14)
- SET TIUPOP=1
- SET TIUNOCS=-1
- QUIT
- +4 SET DIE=8925
- SET DA=TIUDA
- SET DR="1405////^S X=GMRCVP"
- DO ^DIE
- +5 DO UPDTADD(TIUDA,GMRCVP)
- +6 SET GMRCO=+GMRCVP
- SET GMRCSTAT=$SELECT($PIECE(TIUD0,U,5)>6:"COMPLETED",1:"INCOMPLETE")
- +7 DO POST(TIUDA,GMRCSTAT)
- +8 QUIT
- RETREAT(DA,TIUD14) ; If Pt has no requests, retreat gracefully
- +1 NEW DIE,DR,GMRCO,GMRCSTAT
- +2 SET DIE=8925
- SET DR="1405////^S X=$P(TIUD14,U,5)"
- DO ^DIE
- +3 SET GMRCO=+$PIECE(TIUD14,U,5)
- +4 SET GMRCSTAT=$SELECT($PIECE(TIUD0,U,5)>6:"COMPLETED",1:"INCOMPLETE")
- +5 DO POST(TIUDA,GMRCSTAT)
- +6 QUIT
- UPDTADD(TIUDA,TIUCVP) ; Addenda for re-linked original are updated
- +1 ;Update TIU(8925 ONLY. GMR(123 doesn't track individual adda
- +2 IF $$HASADDEN^TIULC1(+TIUDA)
- Begin DoDot:1
- +3 NEW DA
- +4 SET DA=0
- FOR
- SET DA=$ORDER(^TIU(8925,"DAD",+TIUDA,DA))
- if +DA'>0
- QUIT
- Begin DoDot:2
- +5 NEW DR,DIE
- +6 IF '+$$ISADDNDM^TIULC1(+DA)
- QUIT
- +7 SET DR="1405////^S X=TIUCVP"
- +8 SET DIE=8925
- DO ^DIE
- +9 DO ^DIE
- End DoDot:2
- End DoDot:1
- +10 QUIT
- ROLLBACK(TIUDA) ; Roll back CT Record when TIU changes require it
- +1 NEW GMRCDA,DIE,DR,DA
- SET GMRCDA=+$PIECE($GET(^TIU(8925,TIUDA,14)),U,5)
- +2 ;P144
- IF +GMRCDA>0
- DO ROLLBACK^GMRCTIU1(GMRCDA,TIUDA)
- +3 SET DIE="^TIU(8925,"
- SET DA=TIUDA
- SET DR="1405///@"
- DO ^DIE
- +4 QUIT
- CLASS() ; What is the TIU Class (or Document Class) for CONSULTS
- +1 NEW GMRCY
- +2 SET GMRCY=+$ORDER(^TIU(8925.1,"B","CONSULTS",0))
- +3 IF +GMRCY>0
- IF $SELECT($PIECE($GET(^TIU(8925.1,+GMRCY,0)),U,4)="CL":0,$PIECE($GET(^(0)),U,4)="DC":0,1:1)
- SET GMRCY=0
- +4 QUIT GMRCY
- REMCNSLT(TIUDA) ;Remove link to consult if there is one ;*171
- +1 ;TIUDA is a TIU record number
- +2 NEW TIUTYPE,TIUDELX
- +3 SET TIUTYPE=+$GET(^TIU(8925,+TIUDA,0))
- +4 SET TIUDELX=$$DELETE^TIULC1(TIUTYPE)
- +5 IF TIUDELX]""
- XECUTE TIUDELX
- +6 QUIT
- CONSCT(TIUDA,TIUOTTL,TIUNTTL) ;
- +1 ;non cons title to cons title - already handled
- +2 ;cons title to cons title - already handled
- +3 ;cons title to non cons title
- +4 NEW TIUCLASS
- +5 SET TIUCLASS=$$CLASS^TIUCNSLT()
- +6 IF +$$ISA^TIULX(TIUOTTL,TIUCLASS)
- IF '+$$ISA^TIULX(TIUNTTL,TIUCLASS)
- Begin DoDot:1
- +7 WRITE !,"The Title you selected is not a Consults Title."
- +8 WRITE !," The note is currently linked to a Consults Request,"
- +9 WRITE !," but will be disassociated when the title is changed"
- +10 WRITE !," to a non Consults Title.",!
- +11 WRITE !,"Do you want to continue with this Change Title Action?"
- +12 IF +$$READ^TIUU("YO",,"N")'>0
- SET TIUQUIT=1
- +13 IF $GET(TIUQUIT)=1
- WRITE !,"Title not changed."
- QUIT
- +14 DO REMCNSLT(+TIUDA)
- End DoDot:1
- +15 QUIT
- CNSCTGUI(TIUDA,TIUOTTL,TIUNTTL) ;
- +1 ;non cons title to cons title - already handled
- +2 ;cons title to cons title - already handled
- +3 ;cons title to non cons title
- +4 NEW TIUCLASS
- +5 SET TIUCLASS=$$CLASS^TIUCNSLT()
- +6 IF +$$ISA^TIULX(TIUOTTL,TIUCLASS)
- IF '+$$ISA^TIULX(TIUNTTL,TIUCLASS)
- Begin DoDot:1
- +7 ;Assume the confirmation has been taken care of already
- +8 DO REMCNSLT(+TIUDA)
- End DoDot:1
- +9 QUIT