GMRCTIUE ;SLC/DCM,DLT,JFR - Complete/Update TIU notes ;07/10/03 15:26
;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,12,15,17,35**;DEC 27, 1997
;
; This routine invokes IA #2410,#2694,#2833,#2699,#2700
;
Q
ENTER(GMRCO) ; Enter a note in TIU for the consult result
;If consult from list is defined in GMRCO, then use it.
K GMRCQUT N TIUDA,TIUCLASS,GMRCLCK
N GMRCMC
I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO)
Q:$D(GMRCQUT)!'$L($G(GMRCO))
I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D D EDEX Q
. N DIR
. W !,"The requesting facility may not complete an inter-facility "
. W "consult."
. S DIR(0)="E" D ^DIR
I '$$LOCK^GMRCA1(GMRCO) D EDEX Q
S GMRCLCK=1
D CHKSTS I $G(GMRCQUT) D EDEX Q
I $D(VALM) D FULL^VALM1
;
;Find out access if a Clinical Procedure request
N GMRCCP
S GMRCCP=$$CPACTM^GMRCCP(+GMRCO)
;
;If service administrative user, then use administrative complete logic
N GMRCAU
S GMRCAU=$$VALID^GMRCAU($P(^GMR(123,GMRCO,0),U,5))
I GMRCAU=3 D Q
. I $P(^GMR(123,+GMRCO,0),U,12)'=2,'GMRCCP S GMRCMC=$$MED(GMRCO)
. I $G(GMRCMC),$P(^GMR(123,+GMRCO,0),U,12)=2 D EDEX Q
. W !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
. D COMP^GMRCAAC(+GMRCO)
. D EDEX
;
I GMRCAU=4 D I $G(GMRCQIT)=1 D EDEX Q
. N DIRUT
. I $P(^GMR(123,+GMRCO,0),U,12)'=2,'GMRCCP S GMRCMC=$$MED(GMRCO)
. I $G(GMRCMC),$P(^GMR(123,+GMRCO,0),U,12)=2 Q
. S DIR(0)="YA",DIR("A")="Administratively complete this request? "
. D ^DIR I $D(DIRUT) S GMRCQIT=1 Q
. I Y<1 Q
. W !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
. D COMP^GMRCAAC(+GMRCO) S GMRCQIT=1
. Q
;
;Assume the user is a clinical user
I GMRCCP=0 S GMRCMC=$$MED(GMRCO) ;only go med if not a CP
;If a Procedure, allow Medicine or fall through to a note
I $G(GMRCMC) D I $G(GMRCQIT)=1 D EDEX Q
. N DUOUT,DTOUT,DIROUT,DIRUT,X,Y,DIR
. W !
. S DIR(0)="YA",DIR("B")="Y",DIR("A")="Continue with Note Entry? "
. D ^DIR I Y<1 S GMRCQIT=1
. W !
. Q
;
;Get list of notes If no new notes, add new then quit
S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
I $D(VALM) D FULL^VALM1
I '$$GETLIST(GMRCDFN,GMRCO,.GMRCTIUC) D D EDEX Q
. I GMRCCP>1,GMRCCP'=4 D CPGUI Q
. D NEW
;
;If TIU Document already exists, use single record edit, and quit
S GMRCVF="TIU(8925,"
I GMRCTIUC(GMRCVF)=1 D Q
. I GMRCCP=3 D CPGUI Q ;incomplete CP document, must go to GUI
. N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
. D SHOWTIU^GMRCTIUL
. S DIR(0)="YA",DIR("B")="Yes",DIR("A")="Edit/Review this note? "
. D ^DIR I Y>0 D
.. S GMRCTUFN=$$SINGLE(GMRCVF)
.. I +GMRCTUFN D EDITNOTE(GMRCTUFN)
. S DIR(0)="YA"
. S DIR("B")="No",DIR("A")="Would you like to enter a new note? "
. W ! D ^DIR I Y>0 D NEW
. D EDEX
. Q
;
;Show the list of multiple tiu results for selection
D SHOWTIU^GMRCTIUL
;
;Select a note from the list and then get the TIU internal entry
S GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
I $D(GMRCQUT) D EDEX Q
I '+(GMRCSELR) D D EDEX Q
. ;didn't select existing note, allow a new entry
. N DIR,X,Y
. S DIR(0)="Y",DIR("A")="Would you like to enter a new note"
. S DIR("B")="N" D ^DIR
. I Y<1 K DTOUT,DUOUT,X,Y Q
. D NEW
S GMRCTUFN=$$GETTUFN(GMRCSELR)
;
I +GMRCTUFN D EDITNOTE(GMRCTUFN)
;
D EDEX
Q
;
MED(GMRCO) ;allow med results if appropriate
;If a Procedure and setu properly, allow Medicine
N GMRCMED,GMRCQIT S GMRCMED=0
I $P(^GMR(123,+GMRCO,0),U,17)="P" D
. Q:'$P(^GMR(123.3,+$P(^GMR(123,+GMRCO,0),U,8),0),U,5)
. D FULL^VALM1
. N DIR,DIROUT,DTOUT,DUOUT,X,Y
. S DIR(0)="YA",DIR("B")="Y"
. S DIR("A",1)=" ",DIR("A")="Attach Medicine Results? "
. D ^DIR Q:Y<1
. K DIR
. S GMRCMED=1
. D ARMED^GMRCAR
Q GMRCMED
;
SAUSER() ; admin user?
N GMRCSS,GMRCADUS
S GMRCSS=+$P($G(^GMR(123,+GMRCO,0)),"^",5) Q:'+GMRCSS 0
I $D(^GMR(123.5,+$P($G(^GMR(123,+GMRCO,0)),"^",5),123.33,"B",DUZ)) Q 1
I '$L($TEXT(VALIDU^GMRCAU)) Q 0
S GMRCADUS=0
I $L($TEXT(VALIDU^GMRCAU)) D TEAM^GMRCAU(.GMRCADUS,123.34,DUZ)
Q +GMRCADUS
;
CHKSTS ;Check the order status before allowing entry of a note
N STATUS S STATUS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
I $S(STATUS=1:1,STATUS=13:1,1:0) D
. W !,"This order has been "
. W $S(STATUS=1:"DISCONTINUED",1:"CANCELLED")
. W ". A note cannot be entered."
. D PAUSE S GMRCQUT=1
Q
;
EDITNOTE(GMRCTUFN) ;use TIU LM for an existing note
I +$D(^TIU(8925,+GMRCTUFN,0)) D Q
. D EXSTNOTE^TIUBR1(+GMRCDFN,+GMRCTUFN)
;
; link is missing
W !,"A note #"_+GMRCTUFN_" is linked to the consult,"
W !," but the note is no longer in TIU!"
D PAUSE
Q
;
SINGLE(GMRCVF) ;Get the single result entry from the list for the file type
N RSLT,GMRCVP
S RSLT="",GMRCVP=0
F S RSLT=$O(^TMP("GMRC50",$J,RSLT)) Q:RSLT="" D Q:+GMRCVP
. I $P(RSLT,";",2)=GMRCVF S GMRCVP=RSLT
Q +GMRCVP
;
GETTUFN(GMRCSELR) ;Get the result entry from the selected entry
N RSLT
S RSLT=$O(^TMP("GMRC50R",$J,GMRCSELR,""))
Q RSLT
;
NEW ;Enter a new result through TIU if implemented or old Completion logic
S TIUCLASS=+$$CLASS(+$$CPACTM^GMRCCP(+GMRCO))
I TIUCLASS'>0 D Q
. W !!,$C(7),"Consult Resulting through TIU is not yet implemented."
. W !,"Proceeding with Administrative Complete."
. D COMP^GMRCAAC(+GMRCO)
;
N GMRCTIDA
D MAIN^TIUEDIT(TIUCLASS,.GMRCTIDA,GMRCDFN,"","","","",1)
;
Q
;
CLASS(CPSTAT) ; Get TIU doc def for CONSULTS OR clinical procedures
N GMRCY,GMRCDTYP,ERR
I 'CPSTAT D
. S GMRCY=$$FIND1^DIC(8925.1,,"X","CONSULTS","B",,"ERR")
I '$D(GMRCY) D
. S GMRCY=$$FIND1^DIC(8925.1,,"X","CLINICAL PROCEDURES","B",,"ERR")
S GMRCDTYP=$$GET1^DIQ(8925.1,+GMRCY,.04,"I")
I +GMRCY>0,$S(GMRCDTYP="CL":0,GMRCDTYP="DC":0,1:1) S GMRCY=0
Q GMRCY
;
GETLIST(GMRCDFN,GMRCO,GMRCLIST) ;
;
N GMRCVF
;
D GETLIST^GMRCTIUL(GMRCO,2,1,.GMRCTIUC)
S GMRCVF="TIU(8925,"
Q +$G(GMRCTIUC(GMRCVF))
;
ADDEND(GMRCO) ; Make an addendum action for a selected consult
N TIUDA,GMRCTX,GMRCDFN,GMRCADUZ,RSLTINFO,GMRCACT,GMRCTIUC
N GMRCLCK,RSLTIEN
K GMRCQUT
I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO)
Q:$D(GMRCQUT)!'+($G(GMRCO))
;
;If service administrative user, then QUIT.
I $$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5))=3 D Q
. D EXAC^GMRCADC("You do not have the ability to edit this note.")
;
;Assume the user is a clinical user
;
;Get list of notes for this consult. if no notes, then quit.
S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
I '$$GETLIST(GMRCDFN,+GMRCO,.GMRCTIUC) D Q
. W !,"This consult does not yet have an associated note."
. W !," Use the Complete action to enter a new note."
. D PAUSE,EDEX
;
I '$$LOCK^GMRCA1(GMRCO) D EDEX Q
S GMRCLCK=1
;If TIU Document already exists, use single record edit, and quit
S GMRCVF="TIU(8925,"
I GMRCTIUC(GMRCVF)=1 D D EDEX Q
. S GMRCTUFN=$$SINGLE(GMRCVF)
. Q:'+GMRCTUFN
. D SHOWTIU^GMRCTIUL
. N GMRCVP,RSLTINFO,AUTHOR
. S GMRCVP=+GMRCTUFN_";"_GMRCVF
. S RSLTIEN=$O(^TMP("GMRC50",$J,GMRCVP,0))
. S RSLTINFO=$G(^TMP("GMRC50",$J,GMRCVP,RSLTIEN))
. I $P(RSLTINFO,"^",6)="completed" D ADDEND1(+GMRCTUFN) Q
. I (DUZ=+$P(RSLTINFO,"^",4)) D EDITNOTE(+GMRCTUFN) Q
. W !,"You may not addend to the incomplete associated note."
. W !,"You are not the author of the existing note."
. I $$READ^GMRCACMT("Y","Do you want to add a new note ","YES") D NEW
. Q
;
;Show the list of multiple tiu results for selection
D SHOWTIU^GMRCTIUL
;
;Select a note from the list and then get the TIU internal entry
S GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
I $D(GMRCQUT)!'+(GMRCSELR) D EDEX Q
S GMRCTUFN=$$GETTUFN(GMRCSELR)
;
I +GMRCTUFN D ADDEND1(+GMRCTUFN),EDEX Q
;
D EDEX
Q
ADDEND1(TIUDA) ;Add an addendum
;
D FULL^VALM1,ADDEND1^TIURA1
Q
;
EDEX ;
I $G(GMRCLCK) D UNLOCK^GMRCA1(GMRCO)
K GMRCDFN,GMRCO,GMRCQUT,GMRCTUFN,GMRCSEL,GMRCQIT
Q
;
PAUSE ; Pause for user
;
N X W !,"Press <RETURN> to continue: " R X:DTIME E W " (timeout)"
Q
;
CPGUI ;it's GUI way or no way
N MSG
S MSG="You must use the CPRS GUI to complete this Clinical Procedure"
D EXAC^GMRCADC(MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCTIUE 8096 printed Dec 13, 2024@01:47:38 Page 2
GMRCTIUE ;SLC/DCM,DLT,JFR - Complete/Update TIU notes ;07/10/03 15:26
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,10,14,12,15,17,35**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #2410,#2694,#2833,#2699,#2700
+4 ;
+5 QUIT
ENTER(GMRCO) ; Enter a note in TIU for the consult result
+1 ;If consult from list is defined in GMRCO, then use it.
+2 KILL GMRCQUT
NEW TIUDA,TIUCLASS,GMRCLCK
+3 NEW GMRCMC
+4 IF '$LENGTH($GET(GMRCO))
DO SELECT^GMRCA2(.GMRCO)
+5 if $DATA(GMRCQUT)!'$LENGTH($GET(GMRCO))
QUIT
+6 IF $PIECE($GET(^GMR(123,GMRCO,12)),U,5)="P"
Begin DoDot:1
+7 NEW DIR
+8 WRITE !,"The requesting facility may not complete an inter-facility "
+9 WRITE "consult."
+10 SET DIR(0)="E"
DO ^DIR
End DoDot:1
DO EDEX
QUIT
+11 IF '$$LOCK^GMRCA1(GMRCO)
DO EDEX
QUIT
+12 SET GMRCLCK=1
+13 DO CHKSTS
IF $GET(GMRCQUT)
DO EDEX
QUIT
+14 IF $DATA(VALM)
DO FULL^VALM1
+15 ;
+16 ;Find out access if a Clinical Procedure request
+17 NEW GMRCCP
+18 SET GMRCCP=$$CPACTM^GMRCCP(+GMRCO)
+19 ;
+20 ;If service administrative user, then use administrative complete logic
+21 NEW GMRCAU
+22 SET GMRCAU=$$VALID^GMRCAU($PIECE(^GMR(123,GMRCO,0),U,5))
+23 IF GMRCAU=3
Begin DoDot:1
+24 IF $PIECE(^GMR(123,+GMRCO,0),U,12)'=2
IF 'GMRCCP
SET GMRCMC=$$MED(GMRCO)
+25 IF $GET(GMRCMC)
IF $PIECE(^GMR(123,+GMRCO,0),U,12)=2
DO EDEX
QUIT
+26 WRITE !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
+27 DO COMP^GMRCAAC(+GMRCO)
+28 DO EDEX
End DoDot:1
QUIT
+29 ;
+30 IF GMRCAU=4
Begin DoDot:1
+31 NEW DIRUT
+32 IF $PIECE(^GMR(123,+GMRCO,0),U,12)'=2
IF 'GMRCCP
SET GMRCMC=$$MED(GMRCO)
+33 IF $GET(GMRCMC)
IF $PIECE(^GMR(123,+GMRCO,0),U,12)=2
QUIT
+34 SET DIR(0)="YA"
SET DIR("A")="Administratively complete this request? "
+35 DO ^DIR
IF $DATA(DIRUT)
SET GMRCQIT=1
QUIT
+36 IF Y<1
QUIT
+37 WRITE !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
+38 DO COMP^GMRCAAC(+GMRCO)
SET GMRCQIT=1
+39 QUIT
End DoDot:1
IF $GET(GMRCQIT)=1
DO EDEX
QUIT
+40 ;
+41 ;Assume the user is a clinical user
+42 ;only go med if not a CP
IF GMRCCP=0
SET GMRCMC=$$MED(GMRCO)
+43 ;If a Procedure, allow Medicine or fall through to a note
+44 IF $GET(GMRCMC)
Begin DoDot:1
+45 NEW DUOUT,DTOUT,DIROUT,DIRUT,X,Y,DIR
+46 WRITE !
+47 SET DIR(0)="YA"
SET DIR("B")="Y"
SET DIR("A")="Continue with Note Entry? "
+48 DO ^DIR
IF Y<1
SET GMRCQIT=1
+49 WRITE !
+50 QUIT
End DoDot:1
IF $GET(GMRCQIT)=1
DO EDEX
QUIT
+51 ;
+52 ;Get list of notes If no new notes, add new then quit
+53 SET GMRCDFN=$PIECE(^GMR(123,+GMRCO,0),"^",2)
+54 IF $DATA(VALM)
DO FULL^VALM1
+55 IF '$$GETLIST(GMRCDFN,GMRCO,.GMRCTIUC)
Begin DoDot:1
+56 IF GMRCCP>1
IF GMRCCP'=4
DO CPGUI
QUIT
+57 DO NEW
End DoDot:1
DO EDEX
QUIT
+58 ;
+59 ;If TIU Document already exists, use single record edit, and quit
+60 SET GMRCVF="TIU(8925,"
+61 IF GMRCTIUC(GMRCVF)=1
Begin DoDot:1
+62 ;incomplete CP document, must go to GUI
IF GMRCCP=3
DO CPGUI
QUIT
+63 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
+64 DO SHOWTIU^GMRCTIUL
+65 SET DIR(0)="YA"
SET DIR("B")="Yes"
SET DIR("A")="Edit/Review this note? "
+66 DO ^DIR
IF Y>0
Begin DoDot:2
+67 SET GMRCTUFN=$$SINGLE(GMRCVF)
+68 IF +GMRCTUFN
DO EDITNOTE(GMRCTUFN)
End DoDot:2
+69 SET DIR(0)="YA"
+70 SET DIR("B")="No"
SET DIR("A")="Would you like to enter a new note? "
+71 WRITE !
DO ^DIR
IF Y>0
DO NEW
+72 DO EDEX
+73 QUIT
End DoDot:1
QUIT
+74 ;
+75 ;Show the list of multiple tiu results for selection
+76 DO SHOWTIU^GMRCTIUL
+77 ;
+78 ;Select a note from the list and then get the TIU internal entry
+79 SET GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
+80 IF $DATA(GMRCQUT)
DO EDEX
QUIT
+81 IF '+(GMRCSELR)
Begin DoDot:1
+82 ;didn't select existing note, allow a new entry
+83 NEW DIR,X,Y
+84 SET DIR(0)="Y"
SET DIR("A")="Would you like to enter a new note"
+85 SET DIR("B")="N"
DO ^DIR
+86 IF Y<1
KILL DTOUT,DUOUT,X,Y
QUIT
+87 DO NEW
End DoDot:1
DO EDEX
QUIT
+88 SET GMRCTUFN=$$GETTUFN(GMRCSELR)
+89 ;
+90 IF +GMRCTUFN
DO EDITNOTE(GMRCTUFN)
+91 ;
+92 DO EDEX
+93 QUIT
+94 ;
MED(GMRCO) ;allow med results if appropriate
+1 ;If a Procedure and setu properly, allow Medicine
+2 NEW GMRCMED,GMRCQIT
SET GMRCMED=0
+3 IF $PIECE(^GMR(123,+GMRCO,0),U,17)="P"
Begin DoDot:1
+4 if '$PIECE(^GMR(123.3,+$PIECE(^GMR(123,+GMRCO,0),U,8),0),U,5)
QUIT
+5 DO FULL^VALM1
+6 NEW DIR,DIROUT,DTOUT,DUOUT,X,Y
+7 SET DIR(0)="YA"
SET DIR("B")="Y"
+8 SET DIR("A",1)=" "
SET DIR("A")="Attach Medicine Results? "
+9 DO ^DIR
if Y<1
QUIT
+10 KILL DIR
+11 SET GMRCMED=1
+12 DO ARMED^GMRCAR
End DoDot:1
+13 QUIT GMRCMED
+14 ;
SAUSER() ; admin user?
+1 NEW GMRCSS,GMRCADUS
+2 SET GMRCSS=+$PIECE($GET(^GMR(123,+GMRCO,0)),"^",5)
if '+GMRCSS
QUIT 0
+3 IF $DATA(^GMR(123.5,+$PIECE($GET(^GMR(123,+GMRCO,0)),"^",5),123.33,"B",DUZ))
QUIT 1
+4 IF '$LENGTH($TEXT(VALIDU^GMRCAU))
QUIT 0
+5 SET GMRCADUS=0
+6 IF $LENGTH($TEXT(VALIDU^GMRCAU))
DO TEAM^GMRCAU(.GMRCADUS,123.34,DUZ)
+7 QUIT +GMRCADUS
+8 ;
CHKSTS ;Check the order status before allowing entry of a note
+1 NEW STATUS
SET STATUS=$PIECE($GET(^GMR(123,+GMRCO,0)),"^",12)
+2 IF $SELECT(STATUS=1:1,STATUS=13:1,1:0)
Begin DoDot:1
+3 WRITE !,"This order has been "
+4 WRITE $SELECT(STATUS=1:"DISCONTINUED",1:"CANCELLED")
+5 WRITE ". A note cannot be entered."
+6 DO PAUSE
SET GMRCQUT=1
End DoDot:1
+7 QUIT
+8 ;
EDITNOTE(GMRCTUFN) ;use TIU LM for an existing note
+1 IF +$DATA(^TIU(8925,+GMRCTUFN,0))
Begin DoDot:1
+2 DO EXSTNOTE^TIUBR1(+GMRCDFN,+GMRCTUFN)
End DoDot:1
QUIT
+3 ;
+4 ; link is missing
+5 WRITE !,"A note #"_+GMRCTUFN_" is linked to the consult,"
+6 WRITE !," but the note is no longer in TIU!"
+7 DO PAUSE
+8 QUIT
+9 ;
SINGLE(GMRCVF) ;Get the single result entry from the list for the file type
+1 NEW RSLT,GMRCVP
+2 SET RSLT=""
SET GMRCVP=0
+3 FOR
SET RSLT=$ORDER(^TMP("GMRC50",$JOB,RSLT))
if RSLT=""
QUIT
Begin DoDot:1
+4 IF $PIECE(RSLT,";",2)=GMRCVF
SET GMRCVP=RSLT
End DoDot:1
if +GMRCVP
QUIT
+5 QUIT +GMRCVP
+6 ;
GETTUFN(GMRCSELR) ;Get the result entry from the selected entry
+1 NEW RSLT
+2 SET RSLT=$ORDER(^TMP("GMRC50R",$JOB,GMRCSELR,""))
+3 QUIT RSLT
+4 ;
NEW ;Enter a new result through TIU if implemented or old Completion logic
+1 SET TIUCLASS=+$$CLASS(+$$CPACTM^GMRCCP(+GMRCO))
+2 IF TIUCLASS'>0
Begin DoDot:1
+3 WRITE !!,$CHAR(7),"Consult Resulting through TIU is not yet implemented."
+4 WRITE !,"Proceeding with Administrative Complete."
+5 DO COMP^GMRCAAC(+GMRCO)
End DoDot:1
QUIT
+6 ;
+7 NEW GMRCTIDA
+8 DO MAIN^TIUEDIT(TIUCLASS,.GMRCTIDA,GMRCDFN,"","","","",1)
+9 ;
+10 QUIT
+11 ;
CLASS(CPSTAT) ; Get TIU doc def for CONSULTS OR clinical procedures
+1 NEW GMRCY,GMRCDTYP,ERR
+2 IF 'CPSTAT
Begin DoDot:1
+3 SET GMRCY=$$FIND1^DIC(8925.1,,"X","CONSULTS","B",,"ERR")
End DoDot:1
+4 IF '$DATA(GMRCY)
Begin DoDot:1
+5 SET GMRCY=$$FIND1^DIC(8925.1,,"X","CLINICAL PROCEDURES","B",,"ERR")
End DoDot:1
+6 SET GMRCDTYP=$$GET1^DIQ(8925.1,+GMRCY,.04,"I")
+7 IF +GMRCY>0
IF $SELECT(GMRCDTYP="CL":0,GMRCDTYP="DC":0,1:1)
SET GMRCY=0
+8 QUIT GMRCY
+9 ;
GETLIST(GMRCDFN,GMRCO,GMRCLIST) ;
+1 ;
+2 NEW GMRCVF
+3 ;
+4 DO GETLIST^GMRCTIUL(GMRCO,2,1,.GMRCTIUC)
+5 SET GMRCVF="TIU(8925,"
+6 QUIT +$GET(GMRCTIUC(GMRCVF))
+7 ;
ADDEND(GMRCO) ; Make an addendum action for a selected consult
+1 NEW TIUDA,GMRCTX,GMRCDFN,GMRCADUZ,RSLTINFO,GMRCACT,GMRCTIUC
+2 NEW GMRCLCK,RSLTIEN
+3 KILL GMRCQUT
+4 IF '$LENGTH($GET(GMRCO))
DO SELECT^GMRCA2(.GMRCO)
+5 if $DATA(GMRCQUT)!'+($GET(GMRCO))
QUIT
+6 ;
+7 ;If service administrative user, then QUIT.
+8 IF $$VALID^GMRCAU($PIECE(^GMR(123,+GMRCO,0),U,5))=3
Begin DoDot:1
+9 DO EXAC^GMRCADC("You do not have the ability to edit this note.")
End DoDot:1
QUIT
+10 ;
+11 ;Assume the user is a clinical user
+12 ;
+13 ;Get list of notes for this consult. if no notes, then quit.
+14 SET GMRCDFN=$PIECE(^GMR(123,+GMRCO,0),"^",2)
+15 IF '$$GETLIST(GMRCDFN,+GMRCO,.GMRCTIUC)
Begin DoDot:1
+16 WRITE !,"This consult does not yet have an associated note."
+17 WRITE !," Use the Complete action to enter a new note."
+18 DO PAUSE
DO EDEX
End DoDot:1
QUIT
+19 ;
+20 IF '$$LOCK^GMRCA1(GMRCO)
DO EDEX
QUIT
+21 SET GMRCLCK=1
+22 ;If TIU Document already exists, use single record edit, and quit
+23 SET GMRCVF="TIU(8925,"
+24 IF GMRCTIUC(GMRCVF)=1
Begin DoDot:1
+25 SET GMRCTUFN=$$SINGLE(GMRCVF)
+26 if '+GMRCTUFN
QUIT
+27 DO SHOWTIU^GMRCTIUL
+28 NEW GMRCVP,RSLTINFO,AUTHOR
+29 SET GMRCVP=+GMRCTUFN_";"_GMRCVF
+30 SET RSLTIEN=$ORDER(^TMP("GMRC50",$JOB,GMRCVP,0))
+31 SET RSLTINFO=$GET(^TMP("GMRC50",$JOB,GMRCVP,RSLTIEN))
+32 IF $PIECE(RSLTINFO,"^",6)="completed"
DO ADDEND1(+GMRCTUFN)
QUIT
+33 IF (DUZ=+$PIECE(RSLTINFO,"^",4))
DO EDITNOTE(+GMRCTUFN)
QUIT
+34 WRITE !,"You may not addend to the incomplete associated note."
+35 WRITE !,"You are not the author of the existing note."
+36 IF $$READ^GMRCACMT("Y","Do you want to add a new note ","YES")
DO NEW
+37 QUIT
End DoDot:1
DO EDEX
QUIT
+38 ;
+39 ;Show the list of multiple tiu results for selection
+40 DO SHOWTIU^GMRCTIUL
+41 ;
+42 ;Select a note from the list and then get the TIU internal entry
+43 SET GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
+44 IF $DATA(GMRCQUT)!'+(GMRCSELR)
DO EDEX
QUIT
+45 SET GMRCTUFN=$$GETTUFN(GMRCSELR)
+46 ;
+47 IF +GMRCTUFN
DO ADDEND1(+GMRCTUFN)
DO EDEX
QUIT
+48 ;
+49 DO EDEX
+50 QUIT
ADDEND1(TIUDA) ;Add an addendum
+1 ;
+2 DO FULL^VALM1
DO ADDEND1^TIURA1
+3 QUIT
+4 ;
EDEX ;
+1 IF $GET(GMRCLCK)
DO UNLOCK^GMRCA1(GMRCO)
+2 KILL GMRCDFN,GMRCO,GMRCQUT,GMRCTUFN,GMRCSEL,GMRCQIT
+3 QUIT
+4 ;
PAUSE ; Pause for user
+1 ;
+2 NEW X
WRITE !,"Press <RETURN> to continue: "
READ X:DTIME
IF '$TEST
WRITE " (timeout)"
+3 QUIT
+4 ;
CPGUI ;it's GUI way or no way
+1 NEW MSG
+2 SET MSG="You must use the CPRS GUI to complete this Clinical Procedure"
+3 DO EXAC^GMRCADC(MSG)
+4 QUIT
