Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCTIUE

GMRCTIUE.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine invokes IA #2410,#2694,#2833,#2699,#2700
  1. ;
  1. Q
  1. ENTER(GMRCO) ; Enter a note in TIU for the consult result
  1. ;If consult from list is defined in GMRCO, then use it.
  1. K GMRCQUT N TIUDA,TIUCLASS,GMRCLCK
  1. N GMRCMC
  1. I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO)
  1. Q:$D(GMRCQUT)!'$L($G(GMRCO))
  1. I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D D EDEX Q
  1. . N DIR
  1. . W !,"The requesting facility may not complete an inter-facility "
  1. . W "consult."
  1. . S DIR(0)="E" D ^DIR
  1. I '$$LOCK^GMRCA1(GMRCO) D EDEX Q
  1. S GMRCLCK=1
  1. D CHKSTS I $G(GMRCQUT) D EDEX Q
  1. I $D(VALM) D FULL^VALM1
  1. ;
  1. ;Find out access if a Clinical Procedure request
  1. N GMRCCP
  1. S GMRCCP=$$CPACTM^GMRCCP(+GMRCO)
  1. ;
  1. ;If service administrative user, then use administrative complete logic
  1. N GMRCAU
  1. S GMRCAU=$$VALID^GMRCAU($P(^GMR(123,GMRCO,0),U,5))
  1. I GMRCAU=3 D Q
  1. . I $P(^GMR(123,+GMRCO,0),U,12)'=2,'GMRCCP S GMRCMC=$$MED(GMRCO)
  1. . I $G(GMRCMC),$P(^GMR(123,+GMRCO,0),U,12)=2 D EDEX Q
  1. . W !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
  1. . D COMP^GMRCAAC(+GMRCO)
  1. . D EDEX
  1. ;
  1. I GMRCAU=4 D I $G(GMRCQIT)=1 D EDEX Q
  1. . N DIRUT
  1. . I $P(^GMR(123,+GMRCO,0),U,12)'=2,'GMRCCP S GMRCMC=$$MED(GMRCO)
  1. . I $G(GMRCMC),$P(^GMR(123,+GMRCO,0),U,12)=2 Q
  1. . S DIR(0)="YA",DIR("A")="Administratively complete this request? "
  1. . D ^DIR I $D(DIRUT) S GMRCQIT=1 Q
  1. . I Y<1 Q
  1. . W !,$$CJ^XLFSTR("- Proceeding with Administrative Complete -",80)
  1. . D COMP^GMRCAAC(+GMRCO) S GMRCQIT=1
  1. . Q
  1. ;
  1. ;Assume the user is a clinical user
  1. I GMRCCP=0 S GMRCMC=$$MED(GMRCO) ;only go med if not a CP
  1. ;If a Procedure, allow Medicine or fall through to a note
  1. I $G(GMRCMC) D I $G(GMRCQIT)=1 D EDEX Q
  1. . N DUOUT,DTOUT,DIROUT,DIRUT,X,Y,DIR
  1. . W !
  1. . S DIR(0)="YA",DIR("B")="Y",DIR("A")="Continue with Note Entry? "
  1. . D ^DIR I Y<1 S GMRCQIT=1
  1. . W !
  1. . Q
  1. ;
  1. ;Get list of notes If no new notes, add new then quit
  1. S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
  1. I $D(VALM) D FULL^VALM1
  1. I '$$GETLIST(GMRCDFN,GMRCO,.GMRCTIUC) D D EDEX Q
  1. . I GMRCCP>1,GMRCCP'=4 D CPGUI Q
  1. . D NEW
  1. ;
  1. ;If TIU Document already exists, use single record edit, and quit
  1. S GMRCVF="TIU(8925,"
  1. I GMRCTIUC(GMRCVF)=1 D Q
  1. . I GMRCCP=3 D CPGUI Q ;incomplete CP document, must go to GUI
  1. . N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
  1. . D SHOWTIU^GMRCTIUL
  1. . S DIR(0)="YA",DIR("B")="Yes",DIR("A")="Edit/Review this note? "
  1. . D ^DIR I Y>0 D
  1. .. S GMRCTUFN=$$SINGLE(GMRCVF)
  1. .. I +GMRCTUFN D EDITNOTE(GMRCTUFN)
  1. . S DIR(0)="YA"
  1. . S DIR("B")="No",DIR("A")="Would you like to enter a new note? "
  1. . W ! D ^DIR I Y>0 D NEW
  1. . D EDEX
  1. . Q
  1. ;
  1. ;Show the list of multiple tiu results for selection
  1. D SHOWTIU^GMRCTIUL
  1. ;
  1. ;Select a note from the list and then get the TIU internal entry
  1. S GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
  1. I $D(GMRCQUT) D EDEX Q
  1. I '+(GMRCSELR) D D EDEX Q
  1. . ;didn't select existing note, allow a new entry
  1. . N DIR,X,Y
  1. . S DIR(0)="Y",DIR("A")="Would you like to enter a new note"
  1. . S DIR("B")="N" D ^DIR
  1. . I Y<1 K DTOUT,DUOUT,X,Y Q
  1. . D NEW
  1. S GMRCTUFN=$$GETTUFN(GMRCSELR)
  1. ;
  1. I +GMRCTUFN D EDITNOTE(GMRCTUFN)
  1. ;
  1. D EDEX
  1. Q
  1. ;
  1. MED(GMRCO) ;allow med results if appropriate
  1. ;If a Procedure and setu properly, allow Medicine
  1. N GMRCMED,GMRCQIT S GMRCMED=0
  1. I $P(^GMR(123,+GMRCO,0),U,17)="P" D
  1. . Q:'$P(^GMR(123.3,+$P(^GMR(123,+GMRCO,0),U,8),0),U,5)
  1. . D FULL^VALM1
  1. . N DIR,DIROUT,DTOUT,DUOUT,X,Y
  1. . S DIR(0)="YA",DIR("B")="Y"
  1. . S DIR("A",1)=" ",DIR("A")="Attach Medicine Results? "
  1. . D ^DIR Q:Y<1
  1. . K DIR
  1. . S GMRCMED=1
  1. . D ARMED^GMRCAR
  1. Q GMRCMED
  1. ;
  1. SAUSER() ; admin user?
  1. N GMRCSS,GMRCADUS
  1. S GMRCSS=+$P($G(^GMR(123,+GMRCO,0)),"^",5) Q:'+GMRCSS 0
  1. I $D(^GMR(123.5,+$P($G(^GMR(123,+GMRCO,0)),"^",5),123.33,"B",DUZ)) Q 1
  1. I '$L($TEXT(VALIDU^GMRCAU)) Q 0
  1. S GMRCADUS=0
  1. I $L($TEXT(VALIDU^GMRCAU)) D TEAM^GMRCAU(.GMRCADUS,123.34,DUZ)
  1. Q +GMRCADUS
  1. ;
  1. CHKSTS ;Check the order status before allowing entry of a note
  1. N STATUS S STATUS=$P($G(^GMR(123,+GMRCO,0)),"^",12)
  1. I $S(STATUS=1:1,STATUS=13:1,1:0) D
  1. . W !,"This order has been "
  1. . W $S(STATUS=1:"DISCONTINUED",1:"CANCELLED")
  1. . W ". A note cannot be entered."
  1. . D PAUSE S GMRCQUT=1
  1. Q
  1. ;
  1. EDITNOTE(GMRCTUFN) ;use TIU LM for an existing note
  1. I +$D(^TIU(8925,+GMRCTUFN,0)) D Q
  1. . D EXSTNOTE^TIUBR1(+GMRCDFN,+GMRCTUFN)
  1. ;
  1. ; link is missing
  1. W !,"A note #"_+GMRCTUFN_" is linked to the consult,"
  1. W !," but the note is no longer in TIU!"
  1. D PAUSE
  1. Q
  1. ;
  1. SINGLE(GMRCVF) ;Get the single result entry from the list for the file type
  1. N RSLT,GMRCVP
  1. S RSLT="",GMRCVP=0
  1. F S RSLT=$O(^TMP("GMRC50",$J,RSLT)) Q:RSLT="" D Q:+GMRCVP
  1. . I $P(RSLT,";",2)=GMRCVF S GMRCVP=RSLT
  1. Q +GMRCVP
  1. ;
  1. GETTUFN(GMRCSELR) ;Get the result entry from the selected entry
  1. N RSLT
  1. S RSLT=$O(^TMP("GMRC50R",$J,GMRCSELR,""))
  1. Q RSLT
  1. ;
  1. NEW ;Enter a new result through TIU if implemented or old Completion logic
  1. S TIUCLASS=+$$CLASS(+$$CPACTM^GMRCCP(+GMRCO))
  1. I TIUCLASS'>0 D Q
  1. . W !!,$C(7),"Consult Resulting through TIU is not yet implemented."
  1. . W !,"Proceeding with Administrative Complete."
  1. . D COMP^GMRCAAC(+GMRCO)
  1. ;
  1. N GMRCTIDA
  1. D MAIN^TIUEDIT(TIUCLASS,.GMRCTIDA,GMRCDFN,"","","","",1)
  1. ;
  1. Q
  1. ;
  1. CLASS(CPSTAT) ; Get TIU doc def for CONSULTS OR clinical procedures
  1. N GMRCY,GMRCDTYP,ERR
  1. I 'CPSTAT D
  1. . S GMRCY=$$FIND1^DIC(8925.1,,"X","CONSULTS","B",,"ERR")
  1. I '$D(GMRCY) D
  1. . S GMRCY=$$FIND1^DIC(8925.1,,"X","CLINICAL PROCEDURES","B",,"ERR")
  1. S GMRCDTYP=$$GET1^DIQ(8925.1,+GMRCY,.04,"I")
  1. I +GMRCY>0,$S(GMRCDTYP="CL":0,GMRCDTYP="DC":0,1:1) S GMRCY=0
  1. Q GMRCY
  1. ;
  1. GETLIST(GMRCDFN,GMRCO,GMRCLIST) ;
  1. ;
  1. N GMRCVF
  1. ;
  1. D GETLIST^GMRCTIUL(GMRCO,2,1,.GMRCTIUC)
  1. S GMRCVF="TIU(8925,"
  1. Q +$G(GMRCTIUC(GMRCVF))
  1. ;
  1. ADDEND(GMRCO) ; Make an addendum action for a selected consult
  1. N TIUDA,GMRCTX,GMRCDFN,GMRCADUZ,RSLTINFO,GMRCACT,GMRCTIUC
  1. N GMRCLCK,RSLTIEN
  1. K GMRCQUT
  1. I '$L($G(GMRCO)) D SELECT^GMRCA2(.GMRCO)
  1. Q:$D(GMRCQUT)!'+($G(GMRCO))
  1. ;
  1. ;If service administrative user, then QUIT.
  1. I $$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5))=3 D Q
  1. . D EXAC^GMRCADC("You do not have the ability to edit this note.")
  1. ;
  1. ;Assume the user is a clinical user
  1. ;
  1. ;Get list of notes for this consult. if no notes, then quit.
  1. S GMRCDFN=$P(^GMR(123,+GMRCO,0),"^",2)
  1. I '$$GETLIST(GMRCDFN,+GMRCO,.GMRCTIUC) D Q
  1. . W !,"This consult does not yet have an associated note."
  1. . W !," Use the Complete action to enter a new note."
  1. . D PAUSE,EDEX
  1. ;
  1. I '$$LOCK^GMRCA1(GMRCO) D EDEX Q
  1. S GMRCLCK=1
  1. ;If TIU Document already exists, use single record edit, and quit
  1. S GMRCVF="TIU(8925,"
  1. I GMRCTIUC(GMRCVF)=1 D D EDEX Q
  1. . S GMRCTUFN=$$SINGLE(GMRCVF)
  1. . Q:'+GMRCTUFN
  1. . D SHOWTIU^GMRCTIUL
  1. . N GMRCVP,RSLTINFO,AUTHOR
  1. . S GMRCVP=+GMRCTUFN_";"_GMRCVF
  1. . S RSLTIEN=$O(^TMP("GMRC50",$J,GMRCVP,0))
  1. . S RSLTINFO=$G(^TMP("GMRC50",$J,GMRCVP,RSLTIEN))
  1. . I $P(RSLTINFO,"^",6)="completed" D ADDEND1(+GMRCTUFN) Q
  1. . I (DUZ=+$P(RSLTINFO,"^",4)) D EDITNOTE(+GMRCTUFN) Q
  1. . W !,"You may not addend to the incomplete associated note."
  1. . W !,"You are not the author of the existing note."
  1. . I $$READ^GMRCACMT("Y","Do you want to add a new note ","YES") D NEW
  1. . Q
  1. ;
  1. ;Show the list of multiple tiu results for selection
  1. D SHOWTIU^GMRCTIUL
  1. ;
  1. ;Select a note from the list and then get the TIU internal entry
  1. S GMRCSELR=$$SELR^GMRCTIUL(.GMRCTIUC)
  1. I $D(GMRCQUT)!'+(GMRCSELR) D EDEX Q
  1. S GMRCTUFN=$$GETTUFN(GMRCSELR)
  1. ;
  1. I +GMRCTUFN D ADDEND1(+GMRCTUFN),EDEX Q
  1. ;
  1. D EDEX
  1. Q
  1. ADDEND1(TIUDA) ;Add an addendum
  1. ;
  1. D FULL^VALM1,ADDEND1^TIURA1
  1. Q
  1. ;
  1. EDEX ;
  1. I $G(GMRCLCK) D UNLOCK^GMRCA1(GMRCO)
  1. K GMRCDFN,GMRCO,GMRCQUT,GMRCTUFN,GMRCSEL,GMRCQIT
  1. Q
  1. ;
  1. PAUSE ; Pause for user
  1. ;
  1. N X W !,"Press <RETURN> to continue: " R X:DTIME E W " (timeout)"
  1. Q
  1. ;
  1. CPGUI ;it's GUI way or no way
  1. N MSG
  1. S MSG="You must use the CPRS GUI to complete this Clinical Procedure"
  1. D EXAC^GMRCADC(MSG)
  1. Q