- TIUCCRHL7P2 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
- ;;1.0;TEXT INTEGRATION UTILITIES;**337,348,349,352,354,356,366,371**;Sep 27, 2023;Build 4
- ; 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
- ;PB - Patch 371 removes unused code
- 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
- 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
- .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")
- 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=$$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))
- ;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))
- S:$G(TIUX(1301)) TIUX(1301)=+TIUX(1301)
- M @FDARR=TIUX
- D FILE^DIE(FLAGS,"FDA","TIUMSG")
- 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)))
- . 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
- Q ;Patch 371 - PB - stopping this code block from running as CCRA doesn't link to a visit at this time, however leaving
- ; the code in case we need to track and update the visit in the future.
- 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(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 13534 printed Feb 19, 2025@00:05:35 Page 2
- TIUCCRHL7P2 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**337,348,349,352,354,356,366,371**;Sep 27, 2023;Build 4
- +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 ;PB - Patch 371 removes unused code
- +15 QUIT
- CONTINUE ; data verification
- +1 ; DOCUMENT TEXT
- +2 NEW STOP,TIUI,TIUIF
- +3 SET (TIUIF,STOP)=0
- +4 Begin DoDot:1
- +5 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))
- +6 if $GET(STOP)=1
- QUIT
- End DoDot:1
- +7 if $GET(STOP)=1
- QUIT
- +8 ; DOCUMENT TITLE
- +9 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
- +10 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
- +11 if +$GET(TIU("TDA"))'>0!(+$$GET1^DIQ(8925.1,TIU("TDA"),.07,"I")'=11)
- QUIT
- +12 SET TIU("ELSIG")=$$GET1^DIQ(200,$GET(TIU("AUIEN")),20.4)
- +13 IF $GET(TIU("ELSIG"))=""
- Begin DoDot:1
- +14 NEW MSGTEXT
- +15 ;
- SET MSGTEXT="No valid Electronic Signature for "_$GET(TIU("AUNAME"))_" Note is not signed."
- DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)
- +16 KILL TIU("SIGNED"),TIU("CSIGNED")
- End DoDot:1
- +17 SET CONSERVICEIEN=$$GET1^DIQ(123,CONSULTID_",",1,"I")
- +18 SET VLOC=$$GETLOC(CONSERVICEIEN)
- SET TIU("LOC")=VLOC
- +19 DO CONTINUE^TIUCCRHL7P3
- +20 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 NEW CONSERVICEIEN
- +12 SET CONSERVICEIEN=$$GET1^DIQ(123,CONSULTID_",",1,"I")
- +13 NEW TIU,TIUDA,LDT,NEWREC
- +14 SET SUCCESS=0
- +15 IF +$GET(VSIT)
- SET VSTR=$$VSTRBLD(+VSIT)
- +16 IF $LENGTH($GET(VSTR))
- Begin DoDot:1
- +17 SET VDT=$SELECT(+$GET(VDT):+$GET(VDT),1:$PIECE(VSTR,";",2))
- +18 SET LDT=$SELECT(+$GET(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
- +19 SET VLOC=$$GETLOC(CONSERVICEIEN)
- SET TIU("LOC")=VLOC
- +20 ; If note is for Ward Location, call MAIN^TIUMOVE
- +21 IF $PIECE($GET(^SC(+VLOC,0)),U,3)="W"
- DO MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC)
- QUIT
- +22 ; Otherwise, call PATVADPT^TIULV
- +23 DO PATVADPT^TIULV(.TIU,DFN,"",VSTR)
- End DoDot:1
- +24 IF '+$GET(VSIT)
- IF '$LENGTH($GET(VSTR))
- IF +$GET(VDT)
- IF +$GET(VLOC)
- Begin DoDot:1
- +25 SET VDT=$GET(VDT)
- SET LDT=$SELECT(+$GET(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
- +26 ; If note is for Ward Location, call MAIN^TIUMOVE
- +27 IF $PIECE($GET(^SC(+VLOC,0)),U,3)="W"
- DO MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC)
- QUIT
- +28 ; Otherwise, call MAIN^TIUVSIT
- +29 DO MAIN^TIUVSIT(.TIU,DFN,"",VDT,LDT,"LAST",0,VLOC)
- End DoDot:1
- +30 IF '+$GET(TIU("VSTR"))
- Begin DoDot:1
- +31 SET VLOC=$$GETLOC($GET(CONSERVICEIEN))
- SET TIU("LOC")=VLOC
- +32 DO EVENT^TIUSRVP1(.TIU,DFN)
- End DoDot:1
- +33 SET TIU("INST")=$$DIVISION^TIULC1(+TIU("LOC"))
- +34 IF $SELECT($DATA(TIU)'>9:1,+$GET(DFN)'>0:1,1:0)
- SET SUCCESS="0^"_$$EZBLD^DIALOG(89250001)
- QUIT
- +35 NEW %
- DO NOW^%DTC
- +36 SET (TIU("LOC"),TIU("VLOC"))=VLOC_"^"_$$GET1^DIQ(44,VLOC_",",.01,"E")
- SET TIU("VSTR")=VLOC_"^"_%
- +37 SET TIUDA=$$GETREC(DFN,.TIU,TITLE,.NEWREC)
- +38 IF +TIUDA'>0
- SET SUCCESS="0^"_$$EZBLD^DIALOG(89250002)
- QUIT
- +39 SET SUCCESS=+TIUDA
- +40 DO STUFREC^TIUSRVP1(+TIUDA,.TIUX,DFN,,TITLE,.TIU)
- +41 if '+$GET(NOASF)
- SET ^TIU(8925,"ASAVE",DUZ,TIUDA)=""
- +42 KILL ^TIU(8925,+TIUDA,"TEMP")
- +43 MERGE ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
- KILL TIUX("TEXT")
- +44 DO SETXT0(TIUDA)
- +45 DO FILE(.SUCCESS,+TIUDA,.TIUX,+$GET(SUPPRESS))
- +46 IF +SUCCESS'>0
- DO DIK^TIURB2(TIUDA)
- QUIT
- +47 IF +$ORDER(^TIU(8925,+TIUDA,"TEMP",0))
- DO MERGTEXT^TIUEDI1(+TIUDA,.TIU)
- +48 IF +$GET(TIU("STOP"))
- DO DEFER^TIUVSIT(TIUDA,TIU("STOP"))
- IF 1
- +49 IF '$TEST
- DO QUE^TIUPXAP1
- +50 IF '+$GET(SUPPRESS)
- Begin DoDot:1
- +51 DO RELEASE^TIUT(TIUDA,1)
- +52 DO UPDTIRT^TIUDIRT(.TIU,TIUDA)
- End DoDot:1
- +53 ;Patch 352 - PB update field 1205 to be the FROM field (#2) in file 123
- +54 IF $GET(TIUDA)>0
- Begin DoDot:1
- +55 QUIT
- +56 NEW FDA
- +57 ;PB - Sep 23 - Patch 356 changed to used the CONSULTID variable
- SET FDA(1,8925,TIUDA_",",1205)=$$GET1^DIQ(123,CONSULTID_",",2,"I")
- +58 SET FDA(1,8925,TIUDA_",",1211)=VLOC
- +59 DO UPDATE^DIE("","FDA(1)","ZERR")
- End DoDot:1
- +60 KILL ^TIU(8925,+TIUDA,"TEMP")
- +61 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 ;If the document is a member of the Clinical Procedures Class, set the
- +6 ;Entered By field to the Author/Dictator field
- +7 IF $GET(TIUCPF)
- IF +$GET(TIUX(1202))
- SET TIUX(1302)=+$GET(TIUX(1202))
- +8 if $GET(TIUX(1301))
- SET TIUX(1301)=+TIUX(1301)
- +9 MERGE @FDARR=TIUX
- +10 DO FILE^DIE(FLAGS,"FDA","TIUMSG")
- +11 IF $DATA(TIUMSG)>9
- SET SUCCESS=0_U_$GET(TIUMSG("DIERR",1,"TEXT",1))
- QUIT
- +12 SET SUCCESS=TIUDA
- +13 IF '+$GET(SUPPRESS)
- Begin DoDot:1
- +14 NEW DA
- +15 SET DA=TIUDA
- +16 SET TIUCMMTX=$$COMMIT^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
- +17 KILL ^TIU(8925,"ASAVE",DUZ,TIUDA)
- End DoDot:1
- +18 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 ;Patch 371 - PB - stopping this code block from running as CCRA doesn't link to a visit at this time, however leaving
- QUIT
- +2 ; the code in case we need to track and update the visit in the future.
- +3 NEW TIUY,VSIT0,VLOC,VDT,VSVCAT
- +4 SET VSIT0=$GET(^AUPNVSIT(+VSIT,0))
- SET VDT=+$PIECE(VSIT0,U)
- SET VLOC=+$PIECE(VSIT0,U,22)
- +5 SET VSVCAT=$PIECE(VSIT0,U,7)
- +6 SET TIUY=VLOC_";"_VDT_";"_VSVCAT
- +7 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 IF '+$GET(TIUDEL)
- DO ES(TIUDA,TIUES,"",TIU("AUDA"))
- +11 IF '+$GET(TIUDEL)
- SET TIUSTAT=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
- IF TIUSTAT<6
- IF TIU("AVAIL")'="AV"
- Begin DoDot:3
- +12 SET TIUDEL=1
- DO ERR("TIU","","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
- End DoDot:3
- End DoDot:2
- +13 IF +TIU("CSIGNED")
- Begin DoDot:2
- +14 NEW TIUACT,TIUAUTH,TIUES,TIUSTAT
- SET TIUACT="COSIGNATURE"
- SET TIUAUTH=$$CANDO^TIULP(TIUDA,TIUACT,TIU("CSDA"))
- IF '+TIUAUTH
- Begin DoDot:3
- +15 DO ERR("TIU","29","0000.000",$PIECE(TIUAUTH,U,2))
- IF TIU("AVAIL")="AV"
- QUIT
- +16 SET TIUDEL=1
- DO ERR("TIU","29","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
- End DoDot:3
- +17 IF '+$GET(TIUDEL)
- SET TIUES=1_U_$$GET1^DIQ(200,TIU("CSDA"),20.2)_U_$$GET1^DIQ(200,TIU("CSDA"),20.3)
- +18 IF '+$GET(TIUDEL)
- DO ES^TIURS(TIUDA,TIUES,"",TIU("CSDA"))
- +19 IF '+$GET(TIUDEL)
- SET TIUSTAT=$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
- IF TIUSTAT'=7
- IF TIU("AVAIL")'="AV"
- Begin DoDot:3
- +20 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
- +21 IF +$GET(TIUDEL)
- DO DELDOC(TIUDA)
- +22 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