TIUCCRHL7P2 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
;;1.0;TEXT INTEGRATION UTILITIES;**337,348,349,352,354,356,366**;Sep 27, 2023;Build 2
; Reference to CMT^GMRCGUIB in ICR #2980
; Reference to SETCOM^GMRCGUIB, SETDA^GMRCGUIB in ICR #7223
; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
; Reference to ^GMR(123 supported by DBIA #7342
; Reference to ^GMR(123 supported by DBA #3983
;
;PB - Patch 348 modification to parse the note text from NTE segments rather than the OBX segment
;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult
;PB - Patch 352 modifications to set field 1205 in file 8925 to the value in field 2 in file 123 for the consult
;PB - Patch 354 modifications to keep the status of the consult after the note/addendum is filed whether the note/addendum
; originates in CPRS or in HSRM.
;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
Q
CONTINUE ; data verification
;
; DOCUMENT TEXT
N STOP,TIUI,TIUIF
S (TIUIF,STOP)=0
D
. I '$D(TIUZ("TEXT")) S MSGTEXT="Missing DOCUMENT TEXT.",STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$G(CONSULTID))
. Q:$G(STOP)=1
. ;S TIUTMP=0 F S TIUTMP=$O(TIUZ("TEXT",TIUTMP)) Q:'TIUTMP I $G(TIUZ("TEXT",TIUTMP,0))="" S TIUIF=1
. ;I +$G(TIUIF)=1 S MSGTEXT="Missing DOCUMENT TEXT.",STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$G(CONSULTID))
Q:$G(STOP)=1
;
; DOCUMENT TITLE
I +TIU("TDA")'>0 S MSGTEXT="Could not resolve the document title "_TIU("TITLE"),STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$G(CONSULTID)) Q
I +$$GET1^DIQ(8925.1,TIU("TDA"),.07,"I")'=11 S MSGTEXT="The document title "_TIU("TITLE")_" must be ACTIVE before use",STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$G(CONSULTID)) Q
;
Q:+$G(TIU("TDA"))'>0!(+$$GET1^DIQ(8925.1,TIU("TDA"),.07,"I")'=11)
S TIU("ELSIG")=$$GET1^DIQ(200,$G(TIU("AUIEN")),20.4)
I $G(TIU("ELSIG"))="" D
.N MSGTEXT ;I '$D(^VA(200,TIU("AUIEN"))) D
.S MSGTEXT="No valid Electronic Signature for "_$G(TIU("AUNAME"))_" Note is not signed." D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT) ;
.K TIU("SIGNED"),TIU("CSIGNED")
;I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") S TIU("VSTR")=$$VSTRBLD^TIUSRVP(TIU("VNUM")) ;D
S CONSERVICEIEN=$$GET1^DIQ(123,CONSULTID_",",1,"I")
S VLOC=$$GETLOC(CONSERVICEIEN),TIU("LOC")=VLOC
D CONTINUE^TIUCCRHL7P3
Q
MAKE(SUCCESS,DFN,TITLE,VDT,VLOC,VSIT,TIUX,VSTR,SUPPRESS,NOASF) ; New Document
; SUCCESS = (by ref) TIU DOCUMENT # (PTR to 8925)
; = 0^Explanatory message if no SUCCESS
; DFN = Patient (#2)
; TITLE = TIU Document Definition (#8925.1)
; [VDT] = Date(/Time) of Visit
; [VLOC] = Visit Location (HOSPITAL LOCATION)
; [VSIT] = Visit file ien (#9000010)
; [VSTR] = Visit string (i.e., VLOC;VDT;VTYPE)
; [NOASF] = if 1=Do Not Set ASAVE cross-reference
; TIUX = (by ref) array containing field data and document body
;
N CONSERVICEIEN
S CONSERVICEIEN=$$GET1^DIQ(123,CONSULTID_",",1,"I")
N TIU,TIUDA,LDT,NEWREC
S SUCCESS=0
I +$G(VSIT) S VSTR=$$VSTRBLD(+VSIT)
I $L($G(VSTR)) D
. S VDT=$S(+$G(VDT):+$G(VDT),1:$P(VSTR,";",2))
. S LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
. ;S VLOC=$S(+$G(VLOC):+$G(VLOC),1:$P(VSTR,";"))
. S VLOC=$$GETLOC(CONSERVICEIEN),TIU("LOC")=VLOC
. ; If note is for Ward Location, call MAIN^TIUMOVE
. I $P($G(^SC(+VLOC,0)),U,3)="W" D MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC) Q
. ; Otherwise, call PATVADPT^TIULV
. D PATVADPT^TIULV(.TIU,DFN,"",VSTR)
I '+$G(VSIT),'$L($G(VSTR)),+$G(VDT),+$G(VLOC) D
. S VDT=$G(VDT),LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
. ; If note is for Ward Location, call MAIN^TIUMOVE
. I $P($G(^SC(+VLOC,0)),U,3)="W" D MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC) Q
. ; Otherwise, call MAIN^TIUVSIT
. D MAIN^TIUVSIT(.TIU,DFN,"",VDT,LDT,"LAST",0,VLOC)
I '+$G(TIU("VSTR")) D
. S VLOC=$$GETLOC($G(CONSERVICEIEN)),TIU("LOC")=VLOC
. D EVENT^TIUSRVP1(.TIU,DFN)
S TIU("INST")=$$DIVISION^TIULC1(+TIU("LOC"))
I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,1:0) S SUCCESS="0^"_$$EZBLD^DIALOG(89250001) Q
;
N % D NOW^%DTC
S (TIU("LOC"),TIU("VLOC"))=VLOC_"^"_$$GET1^DIQ(44,VLOC_",",.01,"E"),TIU("VSTR")=VLOC_"^"_%
S TIUDA=$$GETREC(DFN,.TIU,TITLE,.NEWREC)
I +TIUDA'>0 S SUCCESS="0^"_$$EZBLD^DIALOG(89250002) Q
S SUCCESS=+TIUDA
D STUFREC^TIUSRVP1(+TIUDA,.TIUX,DFN,,TITLE,.TIU)
S:'+$G(NOASF) ^TIU(8925,"ASAVE",DUZ,TIUDA)=""
K ^TIU(8925,+TIUDA,"TEMP")
M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
D SETXT0(TIUDA)
D FILE(.SUCCESS,+TIUDA,.TIUX,+$G(SUPPRESS))
I +SUCCESS'>0 D DIK^TIURB2(TIUDA) Q
I +$O(^TIU(8925,+TIUDA,"TEMP",0)) D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
I +$G(TIU("STOP")) D DEFER^TIUVSIT(TIUDA,TIU("STOP")) I 1
E D QUE^TIUPXAP1
I '+$G(SUPPRESS) D
. D RELEASE^TIUT(TIUDA,1)
. D UPDTIRT^TIUDIRT(.TIU,TIUDA)
;Patch 352 - PB update field 1205 to be the FROM field (#2) in file 123
I $G(TIUDA)>0 D
.Q
.N FDA
.S FDA(1,8925,TIUDA_",",1205)=$$GET1^DIQ(123,CONSULTID_",",2,"I") ;PB - Sep 23 - Patch 356 changed to used the CONSULTID variable
.S FDA(1,8925,TIUDA_",",1211)=VLOC
.D UPDATE^DIE("","FDA(1)","ZERR")
K ^TIU(8925,+TIUDA,"TEMP")
Q
FILE(SUCCESS,TIUDA,TIUX,SUPPRESS,TIUCPF) ; Call FM Filer & commit
N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUCMMTX
S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS=""
I +$G(TIUX(1202)) S TIUX(1204)=+$G(TIUX(1202))
I +$G(TIUX(1209)) S TIUX(1208)=+$G(TIUX(1209))
;I +$G(TIUX(1405)) S TIUX(1405)=TIU("CNCN")_";GMR(123,"
;If the document is a member of the Clinical Procedures Class, set the
;Entered By field to the Author/Dictator field
I $G(TIUCPF),+$G(TIUX(1202)) S TIUX(1302)=+$G(TIUX(1202))
;*271 Prevent string date in 1301
S:$G(TIUX(1301)) TIUX(1301)=+TIUX(1301)
M @FDARR=TIUX
D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
S SUCCESS=TIUDA
I '+$G(SUPPRESS) D
. N DA
. S DA=TIUDA
. S TIUCMMTX=$$COMMIT^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
. ;I TIUCMMTX]"" X TIUCMMTX
. K ^TIU(8925,"ASAVE",DUZ,TIUDA)
Q
SETXT0(TIUDA) ; Set root node of "TEMP" WP-field
N TIUC,TIUI S (TIUC,TIUI)=0
F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
. S:$D(^TIU(8925,TIUDA,"TEMP",TIUI,0)) TIUC=TIUC+1
S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
Q
VSTRBLD(VSIT) ; Given Visit ien, build Visit-Descriptor String
N TIUY,VSIT0,VLOC,VDT,VSVCAT
S VSIT0=$G(^AUPNVSIT(+VSIT,0)),VDT=+$P(VSIT0,U),VLOC=+$P(VSIT0,U,22)
S VSVCAT=$P(VSIT0,U,7)
S TIUY=VLOC_";"_VDT_";"_VSVCAT
Q TIUY
GETREC(DFN,TIU,TITLE,TIUNEW) ; Get/create document record
N DA,DIC,DIE,DLAYGO,DR,X,Y,TIUDPRM,TIUFPRIV,TIUHIT,TIUSCAT
S (TIUHIT,DA)=0,TIUFPRIV=1
S (DIC,DLAYGO)=8925,DIC(0)="FL"
S X=""""_"`"_+TITLE_"""" D ^DIC K DIC("S")
I +Y'>0 Q Y_U_" Insufficient data to create a new record."
S DA=+Y,TIUNEW=+$P(Y,U,3)
N DIE,DR,TIUVISIT S DIE=8925
S TIUVISIT=$S(+$G(TIU("VISIT")):+$G(TIU("VISIT")),1:"")
S TIUSCAT=$S(+$L($P($G(TIU("CAT")),U)):$P($G(TIU("CAT")),U),+$L($P($G(TIU("VSTR")),";",3)):$P($G(TIU("VSTR")),";",3),1:"")
S DR=".04////"_$$DOCCLASS^TIULC1(+$P(Y,U,2))_";.13////"_TIUSCAT_";1205////"_$P($G(TIU("LOC")),U)_";1211////"_$P($G(TIU("VLOC")),U)_";1212////"_$P($G(TIU("INST")),U)
D ^DIE
Q +$G(DA)
SIGNDOC(TIUDA) ;
N TIUDEL
I $G(TIU("COMP"))="LA",'+TIU("EC") D
. I '+$G(TIU("SIGNED")),'+$G(TIU("CSIGNED")) D Q
. . I TIU("AVAIL")'="AV" D DELDOC(TIUDA),ERR("TIU","","2100.040","SIGNATURE DATE[TIME] missing from HL7 message & availability not 'AV'; document has been deleted.")
. I +TIU("SIGNED") D
. . N TIUACT,TIUAUTH,TIUES,TIUSTAT S TIUACT="SIGNATURE",TIUAUTH=$$CANDO^TIULP(TIUDA,TIUACT,TIU("AUDA")) I '+TIUAUTH D
. . . D ERR("TIU","15","0000.000",$P(TIUAUTH,U,2)) I TIU("AVAIL")="AV" Q
. . . S TIUDEL=1 D ERR("TIU","","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
. . I '+$G(TIUDEL) S TIUES=1_U_$$GET1^DIQ(200,TIU("AUDA"),20.2)_U_$$GET1^DIQ(200,TIU("AUDA"),20.3)
. . ;I '+$G(TIUDEL) D ES^TIUHL7U2(TIUDA,TIUES,"",TIU("AUDA"))
. . I '+$G(TIUDEL) D ES(TIUDA,TIUES,"",TIU("AUDA"))
. . I '+$G(TIUDEL) S TIUSTAT=$P($G(^TIU(8925,TIUDA,0)),U,5) I TIUSTAT<6,TIU("AVAIL")'="AV" D
. . . S TIUDEL=1 D ERR("TIU","","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
. I +TIU("CSIGNED") D
. . N TIUACT,TIUAUTH,TIUES,TIUSTAT S TIUACT="COSIGNATURE",TIUAUTH=$$CANDO^TIULP(TIUDA,TIUACT,TIU("CSDA")) I '+TIUAUTH D
. . . D ERR("TIU","29","0000.000",$P(TIUAUTH,U,2)) I TIU("AVAIL")="AV" Q
. . . S TIUDEL=1 D ERR("TIU","29","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
. . I '+$G(TIUDEL) S TIUES=1_U_$$GET1^DIQ(200,TIU("CSDA"),20.2)_U_$$GET1^DIQ(200,TIU("CSDA"),20.3)
. . I '+$G(TIUDEL) D ES^TIURS(TIUDA,TIUES,"",TIU("CSDA"))
. . I '+$G(TIUDEL) S TIUSTAT=$P($G(^TIU(8925,TIUDA,0)),U,5) I TIUSTAT'=7,TIU("AVAIL")'="AV" D
. . . S TIUDEL=1 D ERR("TIU","29","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
I +$G(TIUDEL) D DELDOC(TIUDA)
Q
DELDOC(TIUDA) ;
N ERR
D DELETE^TIUSRVP(.ERR,TIUDA,"",1)
Q
ERR(TIUSEG,TIUP,TIUNUM,TIUTXT) ;
S TIU("EC")=TIU("EC")+1
S @TIUNAME@("MSGERR",TIU("EC"))="ERR"_TIUFS_TIUSEG_TIUFS_TIUP_TIUFS_TIUFS_TIUNUM_TIUCS_TIUTXT
Q
ES(DA,TIUES,TIUI,TIUESIG) ; ^DIE call for /es/
N SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
N CSNEED,TIUTTL,TIUPSIG,TIUDPRM,DAO,TIUSTWAS,TIUSTIS,DAORIG,TIUCHNG
S TIUSTWAS=$P($G(^TIU(8925,DA,0)),U,5) S:'+$G(TIUESIG) TIUESIG=DUZ
D DOCPRM^TIULC1(+$G(^TIU(8925,+DA,0)),.TIUDPRM,DA)
S TIUSTAT=$P($G(^TIU(8925,+DA,0)),U,5),ESDT=$$NOW^TIULC
S SVCHIEF=+$$ISA^USRLM(TIUESIG,"CLINICAL SERVICE CHIEF")
S SIGNER=$P(^TIU(8925,+DA,12),U,4),COSIGNER=$P(^(12),U,8),CSREQ=0
S CSNEED=+$P($G(^TIU(8925,+DA,15)),U,6)
I +CSNEED,(TIUESIG'=COSIGNER),'+$G(SVCHIEF),(TIUSTAT'=6) S CSREQ=1
I TIUSTAT=5 D
. S DR=".05////"_$S(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+TIUESIG
. I '+$G(CSREQ),+CSNEED,$S(TIUESIG=COSIGNER:1,+$G(SVCHIEF):1,1:0) D
. . S DR=DR_";1506////0;1507////"_ESDT_";1508////"_+TIUESIG_";1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
I TIUSTAT=6 S DR=".05////7;1506////0;1507////"_ESDT_";1508////"_+TIUESIG
Q:'$D(DR)
S DIE=8925 D ^DIE
I TIUSTAT=5 S DR="1503///^S X=$P(TIUES,U,2);1504///^S X=$P(TIUES,U,3);1505////E"
I TIUSTAT=6 D
. N TIUSBY S DR="",TIUSBY=$P($G(^TIU(8925,+DA,15)),U,2)
. I +TIUSBY>0 S DR="1503///^S X=$$SIGNAME^TIULS("_TIUSBY_");1504///^S X=$$SIGTITL^TIULS("_TIUSBY_");"
. S DR=$G(DR)_"1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
S DIE=8925 D ^DIE S:'+$G(TIUCHNG) TIUCHNG=1
D SEND^TIUALRT(DA),SIGNIRT^TIUDIRT(+DA)
S DAORIG=DA
I +$$ISADDNDM^TIULC1(DA) S DA=+$P($G(^TIU(8925,+DA,0)),U,6)
I +$G(CSREQ)'>0 D MAIN^TIUPD(DA,"S") I 1
I +$P(^TIU(8925,+DA,0),U,11) D REMFLAG^TIUVSIT(+DA)
I $D(^TIU(8925,+DA,0)),$P(^(0),U,3)'>0,($P(^(0),U,13)="E"!($$BROKER^XWBLIB)) D
. N D0,DFN,TIU,TIUVSIT
. ;Try to link docmt to an existing visit, quit if successful
. I $$LNKVST^TIUPXAP3(DA,.TIUVSIT) Q
. ;Otherwise set TIU array and DFN to use TIU API which calls PCE
. ;to resolve multiple visits or creates a new visit
. D GETTIU^TIULD(.TIU,DA)
. S DFN=$P($G(^TIU(8925,+DA,0)),U,2)
. D QUE^TIUPXAP1
; post-signature action
N TIUCONS S TIUCONS=-1
D ISCNSLT^TIUCNSLT(.TIUCONS,+$G(^TIU(8925,DA,0)))
I TIUCONS S DA=DAORIG
S TIUSTIS=$P($G(^TIU(8925,DA,0)),U,5)
S TIUTTL=+$G(^TIU(8925,+DA,0)),TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
I +$L(TIUPSIG),'+$G(CSREQ) X TIUPSIG
I TIUCONS,TIUSTIS=7,TIUSTWAS<7,$$HASKIDS^TIUSRVLI(DA) D
. N SEQUENCE,TIUKIDS,TIUINT,TIUK
. S SEQUENCE="D",TIUKIDS="TIUKIDS",TIUINT=0,TIUK=0
. D SETKIDS^TIUSRVLI(TIUKIDS,DA,TIUINT)
. F S TIUK=$O(TIUKIDS(TIUK)) Q:'TIUK D
. . I $P(TIUKIDS(TIUK),U,7)="completed" X TIUPSIG
N GMRCA,GMRCAD,GMRCDUZ,GMRCMT,GMRCO,GMRCSTS,GMRCDA
;Patch 354 - PB - link the note or addendum to the consult then update the status of the consult to the original status
D POST^TIUCNSLT(+DA,"ACTIVE")
S GMRCO=$G(CONSULTID),GMRCSTS=ORIGSTAT,GMRCA=3 ;PB - Sep 23 - changed to use CONSULTID for the lookup
D STATUS^GMRCP
S GMRCAD=$$NOW^XLFDT
S DA=$$SETDA^GMRCGUIB ;7223
S GMRCMT(1)="HSRM added a note and reset the status.",GMRCDUZ=$G(TIU("AUDA")),GMRCAD=""
D SETCOM^GMRCGUIB(.GMRCMT,GMRCDUZ) ;ICR 7223
;PB - Feb 16, 2022 - patch 349 added code to add a comment to the consult activity log
N COMMENT,NOTEDT
S COMMENT(1)=$G(CFNOTE),NOTEDT=$$NOW^XLFDT,GMRCDA=CONSULTID ;PB - Sep 23 - Patch 356 changed to use CONSULTID for the lookup
D CMT^GMRCGUIB(GMRCDA,.COMMENT,GMRCDUZ,NOTEDT,GMRCDUZ) ;icr 2980
Q
POST(TIUDA) ;Patch 354 - PB - link the note or addendum to the consult then update the status of the consult to the original status
N GMRCO,GMRCSTS,GMRCA
S GMRCA=3,GMRCO=$P($P(^TIU(8925,TIUDA,14),"^",5),";",1)
S GMRCSTS=$$GET1^DIQ(123,GMRCO_",",8,"I") ;ICR 3983
D STATUS^GMRCP
S DA=TIUDA
Q
POST1(TIUDA) ;Patch 354 - PB - link the note or addendum to the consult then update the status of the consult to the original status
N GMRCO,GMRCSTS,GMRCA
S GMRCO=+$P($G(^TIU(8925,+TIUDA,14)),U,5),GMRCSTS=$$GET1^DIQ(123,GMRCO_",",8,"I"),GMRCA=3 ;ICR 3983
D POST^TIUCNSLT(DA,"INCOMPLETE")
D STATUS^GMRCP
Q
GETLOC(CONSERV) ;
;gets the location for the visit from the consult service default clinic
N VLOCX,IENS
I CONSERV="" Q 0
S IENS="1,"_CONSERV_"," S VLOCX=$$GET1^DIQ(123.56,IENS,.01,"I")
S IENS=CONSERV_","
I $G(VLOCX)="" S VLOCX=$$CHECKLST^TIUCCHL7UT($$GET1^DIQ(123.5,IENS,.01,"E"))
Q VLOCX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCCRHL7P2 13960 printed Dec 13, 2024@02:39:06 Page 2
TIUCCRHL7P2 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**337,348,349,352,354,356,366**;Sep 27, 2023;Build 2
+2 ; Reference to CMT^GMRCGUIB in ICR #2980
+3 ; Reference to SETCOM^GMRCGUIB, SETDA^GMRCGUIB in ICR #7223
+4 ; Reference to ^TMP("CSLSUR1" supported by DBIA #3498
+5 ; Reference to ^GMR(123 supported by DBIA #7342
+6 ; Reference to ^GMR(123 supported by DBA #3983
+7 ;
+8 ;PB - Patch 348 modification to parse the note text from NTE segments rather than the OBX segment
+9 ;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult
+10 ;PB - Patch 352 modifications to set field 1205 in file 8925 to the value in field 2 in file 123 for the consult
+11 ;PB - Patch 354 modifications to keep the status of the consult after the note/addendum is filed whether the note/addendum
+12 ; originates in CPRS or in HSRM.
+13 ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
+14 QUIT
CONTINUE ; data verification
+1 ;
+2 ; DOCUMENT TEXT
+3 NEW STOP,TIUI,TIUIF
+4 SET (TIUIF,STOP)=0
+5 Begin DoDot:1
+6 IF '$DATA(TIUZ("TEXT"))
SET MSGTEXT="Missing DOCUMENT TEXT."
SET STOP=1
DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)
DO ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$GET(CONSULTID))
+7 if $GET(STOP)=1
QUIT
+8 ;S TIUTMP=0 F S TIUTMP=$O(TIUZ("TEXT",TIUTMP)) Q:'TIUTMP I $G(TIUZ("TEXT",TIUTMP,0))="" S TIUIF=1
+9 ;I +$G(TIUIF)=1 S MSGTEXT="Missing DOCUMENT TEXT.",STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$G(CONSULTID))
End DoDot:1
+10 if $GET(STOP)=1
QUIT
+11 ;
+12 ; DOCUMENT TITLE
+13 IF +TIU("TDA")'>0
SET MSGTEXT="Could not resolve the document title "_TIU("TITLE")
SET STOP=1
DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)
DO ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$GET(CONSULTID))
QUIT
+14 IF +$$GET1^DIQ(8925.1,TIU("TDA"),.07,"I")'=11
SET MSGTEXT="The document title "_TIU("TITLE")_" must be ACTIVE before use"
SET STOP=1
DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)
DO ANAK^TIUCCHL7UT(MSGID,MSGTEXT,$GET(CONSULTID))
QUIT
+15 ;
+16 if +$GET(TIU("TDA"))'>0!(+$$GET1^DIQ(8925.1,TIU("TDA"),.07,"I")'=11)
QUIT
+17 SET TIU("ELSIG")=$$GET1^DIQ(200,$GET(TIU("AUIEN")),20.4)
+18 IF $GET(TIU("ELSIG"))=""
Begin DoDot:1
+19 ;I '$D(^VA(200,TIU("AUIEN"))) D
NEW MSGTEXT
+20 ;
SET MSGTEXT="No valid Electronic Signature for "_$GET(TIU("AUNAME"))_" Note is not signed."
DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)
+21 KILL TIU("SIGNED"),TIU("CSIGNED")
End DoDot:1
+22 ;I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") S TIU("VSTR")=$$VSTRBLD^TIUSRVP(TIU("VNUM")) ;D
+23 SET CONSERVICEIEN=$$GET1^DIQ(123,CONSULTID_",",1,"I")
+24 SET VLOC=$$GETLOC(CONSERVICEIEN)
SET TIU("LOC")=VLOC
+25 DO CONTINUE^TIUCCRHL7P3
+26 QUIT
MAKE(SUCCESS,DFN,TITLE,VDT,VLOC,VSIT,TIUX,VSTR,SUPPRESS,NOASF) ; New Document
+1 ; SUCCESS = (by ref) TIU DOCUMENT # (PTR to 8925)
+2 ; = 0^Explanatory message if no SUCCESS
+3 ; DFN = Patient (#2)
+4 ; TITLE = TIU Document Definition (#8925.1)
+5 ; [VDT] = Date(/Time) of Visit
+6 ; [VLOC] = Visit Location (HOSPITAL LOCATION)
+7 ; [VSIT] = Visit file ien (#9000010)
+8 ; [VSTR] = Visit string (i.e., VLOC;VDT;VTYPE)
+9 ; [NOASF] = if 1=Do Not Set ASAVE cross-reference
+10 ; TIUX = (by ref) array containing field data and document body
+11 ;
+12 NEW CONSERVICEIEN
+13 SET CONSERVICEIEN=$$GET1^DIQ(123,CONSULTID_",",1,"I")
+14 NEW TIU,TIUDA,LDT,NEWREC
+15 SET SUCCESS=0
+16 IF +$GET(VSIT)
SET VSTR=$$VSTRBLD(+VSIT)
+17 IF $LENGTH($GET(VSTR))
Begin DoDot:1
+18 SET VDT=$SELECT(+$GET(VDT):+$GET(VDT),1:$PIECE(VSTR,";",2))
+19 SET LDT=$SELECT(+$GET(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
+20 ;S VLOC=$S(+$G(VLOC):+$G(VLOC),1:$P(VSTR,";"))
+21 SET VLOC=$$GETLOC(CONSERVICEIEN)
SET TIU("LOC")=VLOC
+22 ; If note is for Ward Location, call MAIN^TIUMOVE
+23 IF $PIECE($GET(^SC(+VLOC,0)),U,3)="W"
DO MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC)
QUIT
+24 ; Otherwise, call PATVADPT^TIULV
+25 DO PATVADPT^TIULV(.TIU,DFN,"",VSTR)
End DoDot:1
+26 IF '+$GET(VSIT)
IF '$LENGTH($GET(VSTR))
IF +$GET(VDT)
IF +$GET(VLOC)
Begin DoDot:1
+27 SET VDT=$GET(VDT)
SET LDT=$SELECT(+$GET(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
+28 ; If note is for Ward Location, call MAIN^TIUMOVE
+29 IF $PIECE($GET(^SC(+VLOC,0)),U,3)="W"
DO MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC)
QUIT
+30 ; Otherwise, call MAIN^TIUVSIT
+31 DO MAIN^TIUVSIT(.TIU,DFN,"",VDT,LDT,"LAST",0,VLOC)
End DoDot:1
+32 IF '+$GET(TIU("VSTR"))
Begin DoDot:1
+33 SET VLOC=$$GETLOC($GET(CONSERVICEIEN))
SET TIU("LOC")=VLOC
+34 DO EVENT^TIUSRVP1(.TIU,DFN)
End DoDot:1
+35 SET TIU("INST")=$$DIVISION^TIULC1(+TIU("LOC"))
+36 IF $SELECT($DATA(TIU)'>9:1,+$GET(DFN)'>0:1,1:0)
SET SUCCESS="0^"_$$EZBLD^DIALOG(89250001)
QUIT
+37 ;
+38 NEW %
DO NOW^%DTC
+39 SET (TIU("LOC"),TIU("VLOC"))=VLOC_"^"_$$GET1^DIQ(44,VLOC_",",.01,"E")
SET TIU("VSTR")=VLOC_"^"_%
+40 SET TIUDA=$$GETREC(DFN,.TIU,TITLE,.NEWREC)
+41 IF +TIUDA'>0
SET SUCCESS="0^"_$$EZBLD^DIALOG(89250002)
QUIT
+42 SET SUCCESS=+TIUDA
+43 DO STUFREC^TIUSRVP1(+TIUDA,.TIUX,DFN,,TITLE,.TIU)
+44 if '+$GET(NOASF)
SET ^TIU(8925,"ASAVE",DUZ,TIUDA)=""
+45 KILL ^TIU(8925,+TIUDA,"TEMP")
+46 MERGE ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
KILL TIUX("TEXT")
+47 DO SETXT0(TIUDA)
+48 DO FILE(.SUCCESS,+TIUDA,.TIUX,+$GET(SUPPRESS))
+49 IF +SUCCESS'>0
DO DIK^TIURB2(TIUDA)
QUIT
+50 IF +$ORDER(^TIU(8925,+TIUDA,"TEMP",0))
DO MERGTEXT^TIUEDI1(+TIUDA,.TIU)
+51 IF +$GET(TIU("STOP"))
DO DEFER^TIUVSIT(TIUDA,TIU("STOP"))
IF 1
+52 IF '$TEST
DO QUE^TIUPXAP1
+53 IF '+$GET(SUPPRESS)
Begin DoDot:1
+54 DO RELEASE^TIUT(TIUDA,1)
+55 DO UPDTIRT^TIUDIRT(.TIU,TIUDA)
End DoDot:1
+56 ;Patch 352 - PB update field 1205 to be the FROM field (#2) in file 123
+57 IF $GET(TIUDA)>0
Begin DoDot:1
+58 QUIT
+59 NEW FDA
+60 ;PB - Sep 23 - Patch 356 changed to used the CONSULTID variable
SET FDA(1,8925,TIUDA_",",1205)=$$GET1^DIQ(123,CONSULTID_",",2,"I")
+61 SET FDA(1,8925,TIUDA_",",1211)=VLOC
+62 DO UPDATE^DIE("","FDA(1)","ZERR")
End DoDot:1
+63 KILL ^TIU(8925,+TIUDA,"TEMP")
+64 QUIT
FILE(SUCCESS,TIUDA,TIUX,SUPPRESS,TIUCPF) ; Call FM Filer & commit
+1 NEW FDA,FDARR,IENS,FLAGS,TIUMSG,TIUCMMTX
+2 SET IENS=""""_TIUDA_","""
SET FDARR="FDA(8925,"_IENS_")"
SET FLAGS=""
+3 IF +$GET(TIUX(1202))
SET TIUX(1204)=+$GET(TIUX(1202))
+4 IF +$GET(TIUX(1209))
SET TIUX(1208)=+$GET(TIUX(1209))
+5 ;I +$G(TIUX(1405)) S TIUX(1405)=TIU("CNCN")_";GMR(123,"
+6 ;If the document is a member of the Clinical Procedures Class, set the
+7 ;Entered By field to the Author/Dictator field
+8 IF $GET(TIUCPF)
IF +$GET(TIUX(1202))
SET TIUX(1302)=+$GET(TIUX(1202))
+9 ;*271 Prevent string date in 1301
+10 if $GET(TIUX(1301))
SET TIUX(1301)=+TIUX(1301)
+11 MERGE @FDARR=TIUX
+12 ; File record
DO FILE^DIE(FLAGS,"FDA","TIUMSG")
+13 IF $DATA(TIUMSG)>9
SET SUCCESS=0_U_$GET(TIUMSG("DIERR",1,"TEXT",1))
QUIT
+14 SET SUCCESS=TIUDA
+15 IF '+$GET(SUPPRESS)
Begin DoDot:1
+16 NEW DA
+17 SET DA=TIUDA
+18 SET TIUCMMTX=$$COMMIT^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+19 ;I TIUCMMTX]"" X TIUCMMTX
+20 KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
End DoDot:1
+21 QUIT
SETXT0(TIUDA) ; Set root node of "TEMP" WP-field
+1 NEW TIUC,TIUI
SET (TIUC,TIUI)=0
+2 FOR
SET TIUI=$ORDER(^TIU(8925,TIUDA,"TEMP",TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+3 if $DATA(^TIU(8925,TIUDA,"TEMP",TIUI,0))
SET TIUC=TIUC+1
End DoDot:1
+4 SET ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
+5 QUIT
VSTRBLD(VSIT) ; Given Visit ien, build Visit-Descriptor String
+1 NEW TIUY,VSIT0,VLOC,VDT,VSVCAT
+2 SET VSIT0=$GET(^AUPNVSIT(+VSIT,0))
SET VDT=+$PIECE(VSIT0,U)
SET VLOC=+$PIECE(VSIT0,U,22)
+3 SET VSVCAT=$PIECE(VSIT0,U,7)
+4 SET TIUY=VLOC_";"_VDT_";"_VSVCAT
+5 QUIT TIUY
GETREC(DFN,TIU,TITLE,TIUNEW) ; Get/create document record
+1 NEW DA,DIC,DIE,DLAYGO,DR,X,Y,TIUDPRM,TIUFPRIV,TIUHIT,TIUSCAT
+2 SET (TIUHIT,DA)=0
SET TIUFPRIV=1
+3 SET (DIC,DLAYGO)=8925
SET DIC(0)="FL"
+4 SET X=""""_"`"_+TITLE_""""
DO ^DIC
KILL DIC("S")
+5 IF +Y'>0
QUIT Y_U_" Insufficient data to create a new record."
+6 SET DA=+Y
SET TIUNEW=+$PIECE(Y,U,3)
+7 NEW DIE,DR,TIUVISIT
SET DIE=8925
+8 SET TIUVISIT=$SELECT(+$GET(TIU("VISIT")):+$GET(TIU("VISIT")),1:"")
+9 SET TIUSCAT=$SELECT(+$LENGTH($PIECE($GET(TIU("CAT")),U)):$PIECE($GET(TIU("CAT")),U),+$LENGTH($PIECE($GET(TIU("VSTR")),";",3)):$PIECE($GET(TIU("VSTR")),";",3),1:"")
+10 SET DR=".04////"_$$DOCCLASS^TIULC1(+$PIECE(Y,U,2))_";.13////"_TIUSCAT_";1205////"_$PIECE($GET(TIU("LOC")),U)_";1211////"_$PIECE($GET(TIU("VLOC")),U)_";1212////"_$PIECE($GET(TIU("INST")),U)
+11 DO ^DIE
+12 QUIT +$GET(DA)
SIGNDOC(TIUDA) ;
+1 NEW TIUDEL
+2 IF $GET(TIU("COMP"))="LA"
IF '+TIU("EC")
Begin DoDot:1
+3 IF '+$GET(TIU("SIGNED"))
IF '+$GET(TIU("CSIGNED"))
Begin DoDot:2
+4 IF TIU("AVAIL")'="AV"
DO DELDOC(TIUDA)
DO ERR("TIU","","2100.040","SIGNATURE DATE[TIME] missing from HL7 message & availability not 'AV'; document has been deleted.")
End DoDot:2
QUIT
+5 IF +TIU("SIGNED")
Begin DoDot:2
+6 NEW TIUACT,TIUAUTH,TIUES,TIUSTAT
SET TIUACT="SIGNATURE"
SET TIUAUTH=$$CANDO^TIULP(TIUDA,TIUACT,TIU("AUDA"))
IF '+TIUAUTH
Begin DoDot:3
+7 DO ERR("TIU","15","0000.000",$PIECE(TIUAUTH,U,2))
IF TIU("AVAIL")="AV"
QUIT
+8 SET TIUDEL=1
DO ERR("TIU","","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
End DoDot:3
+9 IF '+$GET(TIUDEL)
SET TIUES=1_U_$$GET1^DIQ(200,TIU("AUDA"),20.2)_U_$$GET1^DIQ(200,TIU("AUDA"),20.3)
+10 ;I '+$G(TIUDEL) D ES^TIUHL7U2(TIUDA,TIUES,"",TIU("AUDA"))
+11 IF '+$GET(TIUDEL)
DO ES(TIUDA,TIUES,"",TIU("AUDA"))
+12 IF '+$GET(TIUDEL)
SET TIUSTAT=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
IF TIUSTAT<6
IF TIU("AVAIL")'="AV"
Begin DoDot:3
+13 SET TIUDEL=1
DO ERR("TIU","","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
End DoDot:3
End DoDot:2
+14 IF +TIU("CSIGNED")
Begin DoDot:2
+15 NEW TIUACT,TIUAUTH,TIUES,TIUSTAT
SET TIUACT="COSIGNATURE"
SET TIUAUTH=$$CANDO^TIULP(TIUDA,TIUACT,TIU("CSDA"))
IF '+TIUAUTH
Begin DoDot:3
+16 DO ERR("TIU","29","0000.000",$PIECE(TIUAUTH,U,2))
IF TIU("AVAIL")="AV"
QUIT
+17 SET TIUDEL=1
DO ERR("TIU","29","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
End DoDot:3
+18 IF '+$GET(TIUDEL)
SET TIUES=1_U_$$GET1^DIQ(200,TIU("CSDA"),20.2)_U_$$GET1^DIQ(200,TIU("CSDA"),20.3)
+19 IF '+$GET(TIUDEL)
DO ES^TIURS(TIUDA,TIUES,"",TIU("CSDA"))
+20 IF '+$GET(TIUDEL)
SET TIUSTAT=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
IF TIUSTAT'=7
IF TIU("AVAIL")'="AV"
Begin DoDot:3
+21 SET TIUDEL=1
DO ERR("TIU","29","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF +$GET(TIUDEL)
DO DELDOC(TIUDA)
+23 QUIT
DELDOC(TIUDA) ;
+1 NEW ERR
+2 DO DELETE^TIUSRVP(.ERR,TIUDA,"",1)
+3 QUIT
ERR(TIUSEG,TIUP,TIUNUM,TIUTXT) ;
+1 SET TIU("EC")=TIU("EC")+1
+2 SET @TIUNAME@("MSGERR",TIU("EC"))="ERR"_TIUFS_TIUSEG_TIUFS_TIUP_TIUFS_TIUFS_TIUNUM_TIUCS_TIUTXT
+3 QUIT
ES(DA,TIUES,TIUI,TIUESIG) ; ^DIE call for /es/
+1 NEW SIGNER,DR,DIE,ESDT,TIUSTAT,TIUSTNOW,COSIGNER,SVCHIEF,CSREQ,TIUPRINT
+2 NEW CSNEED,TIUTTL,TIUPSIG,TIUDPRM,DAO,TIUSTWAS,TIUSTIS,DAORIG,TIUCHNG
+3 SET TIUSTWAS=$PIECE($GET(^TIU(8925,DA,0)),U,5)
if '+$GET(TIUESIG)
SET TIUESIG=DUZ
+4 DO DOCPRM^TIULC1(+$GET(^TIU(8925,+DA,0)),.TIUDPRM,DA)
+5 SET TIUSTAT=$PIECE($GET(^TIU(8925,+DA,0)),U,5)
SET ESDT=$$NOW^TIULC
+6 SET SVCHIEF=+$$ISA^USRLM(TIUESIG,"CLINICAL SERVICE CHIEF")
+7 SET SIGNER=$PIECE(^TIU(8925,+DA,12),U,4)
SET COSIGNER=$PIECE(^(12),U,8)
SET CSREQ=0
+8 SET CSNEED=+$PIECE($GET(^TIU(8925,+DA,15)),U,6)
+9 IF +CSNEED
IF (TIUESIG'=COSIGNER)
IF '+$GET(SVCHIEF)
IF (TIUSTAT'=6)
SET CSREQ=1
+10 IF TIUSTAT=5
Begin DoDot:1
+11 SET DR=".05////"_$SELECT(+CSREQ:6,1:7)_";1501////"_ESDT_";1502////"_+TIUESIG
+12 IF '+$GET(CSREQ)
IF +CSNEED
IF $SELECT(TIUESIG=COSIGNER:1,+$GET(SVCHIEF):1,1:0)
Begin DoDot:2
+13 SET DR=DR_";1506////0;1507////"_ESDT_";1508////"_+TIUESIG_";1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
End DoDot:2
End DoDot:1
+14 IF TIUSTAT=6
SET DR=".05////7;1506////0;1507////"_ESDT_";1508////"_+TIUESIG
+15 if '$DATA(DR)
QUIT
+16 SET DIE=8925
DO ^DIE
+17 IF TIUSTAT=5
SET DR="1503///^S X=$P(TIUES,U,2);1504///^S X=$P(TIUES,U,3);1505////E"
+18 IF TIUSTAT=6
Begin DoDot:1
+19 NEW TIUSBY
SET DR=""
SET TIUSBY=$PIECE($GET(^TIU(8925,+DA,15)),U,2)
+20 IF +TIUSBY>0
SET DR="1503///^S X=$$SIGNAME^TIULS("_TIUSBY_");1504///^S X=$$SIGTITL^TIULS("_TIUSBY_");"
+21 SET DR=$GET(DR)_"1509///^S X=$P(TIUES,U,2);1510///^S X=$P(TIUES,U,3);1511////E"
End DoDot:1
+22 SET DIE=8925
DO ^DIE
if '+$GET(TIUCHNG)
SET TIUCHNG=1
+23 DO SEND^TIUALRT(DA)
DO SIGNIRT^TIUDIRT(+DA)
+24 SET DAORIG=DA
+25 IF +$$ISADDNDM^TIULC1(DA)
SET DA=+$PIECE($GET(^TIU(8925,+DA,0)),U,6)
+26 IF +$GET(CSREQ)'>0
DO MAIN^TIUPD(DA,"S")
IF 1
+27 IF +$PIECE(^TIU(8925,+DA,0),U,11)
DO REMFLAG^TIUVSIT(+DA)
+28 IF $DATA(^TIU(8925,+DA,0))
IF $PIECE(^(0),U,3)'>0
IF ($PIECE(^(0),U,13)="E"!($$BROKER^XWBLIB))
Begin DoDot:1
+29 NEW D0,DFN,TIU,TIUVSIT
+30 ;Try to link docmt to an existing visit, quit if successful
+31 IF $$LNKVST^TIUPXAP3(DA,.TIUVSIT)
QUIT
+32 ;Otherwise set TIU array and DFN to use TIU API which calls PCE
+33 ;to resolve multiple visits or creates a new visit
+34 DO GETTIU^TIULD(.TIU,DA)
+35 SET DFN=$PIECE($GET(^TIU(8925,+DA,0)),U,2)
+36 DO QUE^TIUPXAP1
End DoDot:1
+37 ; post-signature action
+38 NEW TIUCONS
SET TIUCONS=-1
+39 DO ISCNSLT^TIUCNSLT(.TIUCONS,+$GET(^TIU(8925,DA,0)))
+40 IF TIUCONS
SET DA=DAORIG
+41 SET TIUSTIS=$PIECE($GET(^TIU(8925,DA,0)),U,5)
+42 SET TIUTTL=+$GET(^TIU(8925,+DA,0))
SET TIUPSIG=$$POSTSIGN^TIULC1(TIUTTL)
+43 IF +$LENGTH(TIUPSIG)
IF '+$GET(CSREQ)
XECUTE TIUPSIG
+44 IF TIUCONS
IF TIUSTIS=7
IF TIUSTWAS<7
IF $$HASKIDS^TIUSRVLI(DA)
Begin DoDot:1
+45 NEW SEQUENCE,TIUKIDS,TIUINT,TIUK
+46 SET SEQUENCE="D"
SET TIUKIDS="TIUKIDS"
SET TIUINT=0
SET TIUK=0
+47 DO SETKIDS^TIUSRVLI(TIUKIDS,DA,TIUINT)
+48 FOR
SET TIUK=$ORDER(TIUKIDS(TIUK))
if 'TIUK
QUIT
Begin DoDot:2
+49 IF $PIECE(TIUKIDS(TIUK),U,7)="completed"
XECUTE TIUPSIG
End DoDot:2
End DoDot:1
+50 NEW GMRCA,GMRCAD,GMRCDUZ,GMRCMT,GMRCO,GMRCSTS,GMRCDA
+51 ;Patch 354 - PB - link the note or addendum to the consult then update the status of the consult to the original status
+52 DO POST^TIUCNSLT(+DA,"ACTIVE")
+53 ;PB - Sep 23 - changed to use CONSULTID for the lookup
SET GMRCO=$GET(CONSULTID)
SET GMRCSTS=ORIGSTAT
SET GMRCA=3
+54 DO STATUS^GMRCP
+55 SET GMRCAD=$$NOW^XLFDT
+56 ;7223
SET DA=$$SETDA^GMRCGUIB
+57 SET GMRCMT(1)="HSRM added a note and reset the status."
SET GMRCDUZ=$GET(TIU("AUDA"))
SET GMRCAD=""
+58 ;ICR 7223
DO SETCOM^GMRCGUIB(.GMRCMT,GMRCDUZ)
+59 ;PB - Feb 16, 2022 - patch 349 added code to add a comment to the consult activity log
+60 NEW COMMENT,NOTEDT
+61 ;PB - Sep 23 - Patch 356 changed to use CONSULTID for the lookup
SET COMMENT(1)=$GET(CFNOTE)
SET NOTEDT=$$NOW^XLFDT
SET GMRCDA=CONSULTID
+62 ;icr 2980
DO CMT^GMRCGUIB(GMRCDA,.COMMENT,GMRCDUZ,NOTEDT,GMRCDUZ)
+63 QUIT
POST(TIUDA) ;Patch 354 - PB - link the note or addendum to the consult then update the status of the consult to the original status
+1 NEW GMRCO,GMRCSTS,GMRCA
+2 SET GMRCA=3
SET GMRCO=$PIECE($PIECE(^TIU(8925,TIUDA,14),"^",5),";",1)
+3 ;ICR 3983
SET GMRCSTS=$$GET1^DIQ(123,GMRCO_",",8,"I")
+4 DO STATUS^GMRCP
+5 SET DA=TIUDA
+6 QUIT
POST1(TIUDA) ;Patch 354 - PB - link the note or addendum to the consult then update the status of the consult to the original status
+1 NEW GMRCO,GMRCSTS,GMRCA
+2 ;ICR 3983
SET GMRCO=+$PIECE($GET(^TIU(8925,+TIUDA,14)),U,5)
SET GMRCSTS=$$GET1^DIQ(123,GMRCO_",",8,"I")
SET GMRCA=3
+3 DO POST^TIUCNSLT(DA,"INCOMPLETE")
+4 DO STATUS^GMRCP
+5 QUIT
GETLOC(CONSERV) ;
+1 ;gets the location for the visit from the consult service default clinic
+2 NEW VLOCX,IENS
+3 IF CONSERV=""
QUIT 0
+4 SET IENS="1,"_CONSERV_","
SET VLOCX=$$GET1^DIQ(123.56,IENS,.01,"I")
+5 SET IENS=CONSERV_","
+6 IF $GET(VLOCX)=""
SET VLOCX=$$CHECKLST^TIUCCHL7UT($$GET1^DIQ(123.5,IENS,.01,"E"))
+7 QUIT VLOCX
