- 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 Feb 18, 2025@23:14:01 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