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

TIUSRVP.m

Go to the documentation of this file.
  1. TIUSRVP ;SLC/JER - RPCs for CREATE & UPDATE ;Jan 31, 2024@07:30
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**1,7,19,28,47,89,104,100,115,109,167,113,112,175,157,184,239,271,290,362**;Jun 20, 1997;Build 3
  1. ;
  1. ; Reference to File ^AUPNVSIT supported by ICR #3580
  1. ; Reference to File ^SC( supported by ICR #93
  1. ; Reference to *^DIALOG supported by ICR #2050
  1. ; Reference to ^DIC supported by ICR #10006
  1. ; Reference to ^DIE supported by ICR #10018
  1. ; Reference to FINDVISIT^PXUTLVST supported by ICR #7435
  1. ; Reference to *^XLFDT supported by ICR #10103
  1. ;
  1. Q
  1. MAKE(SUCCESS,DFN,TITLE,VDT,VLOC,VSIT,TIUX,VSTR,SUPPRESS,NOASF) ; New Document
  1. ; SUCCESS = (by ref) TIU DOCUMENT # (PTR to 8925)
  1. ; = 0^Explanatory message if no SUCCESS
  1. ; DFN = Patient (#2)
  1. ; TITLE = TIU Document Definition (#8925.1)
  1. ; [VDT] = Date(/Time) of Visit
  1. ; [VLOC] = Visit Location (HOSPITAL LOCATION)
  1. ; [VSIT] = Visit file ien (#9000010)
  1. ; [VSTR] = Visit string (i.e., VLOC;VDT;VTYPE)
  1. ; [NOASF] = if 1=Do Not Set ASAVE cross-reference
  1. ; TIUX = (by ref) array containing field data and document body
  1. ;
  1. N TIU,TIUDA,LDT,NEWREC
  1. S SUCCESS=0
  1. ; *362 ajb, use first visit found
  1. I '+$G(VSIT),$L($G(VSTR)) D
  1. . N VISIT D FINDVISIT^PXUTLVST(DFN,$P(VSTR,";",2),+VSTR,$P(VSTR,";",3),"","","","",1,.VISIT)
  1. . S:+VISIT(0)>0 (VSIT,TIU("VISIT"))=VISIT(1)
  1. ; *362 ajb
  1. I +$G(VSIT) S VSTR=$$VSTRBLD(+VSIT)
  1. I $L($G(VSTR)) D
  1. . S VDT=$S(+$G(VDT):+$G(VDT),1:$P(VSTR,";",2))
  1. . S LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
  1. . S VLOC=$S(+$G(VLOC):+$G(VLOC),1:$P(VSTR,";"))
  1. . ; If note is for Ward Location, call MAIN^TIUMOVE
  1. . I $P($G(^SC(+VLOC,0)),U,3)="W" D MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC) Q
  1. . ; Otherwise, call PATVADPT^TIULV
  1. . D PATVADPT^TIULV(.TIU,DFN,"",VSTR)
  1. I '+$G(VSIT),'$L($G(VSTR)),+$G(VDT),+$G(VLOC) D
  1. . S VDT=$G(VDT),LDT=$S(+$G(VDT):$$FMADD^XLFDT(VDT,"","",1),1:"")
  1. . ; If note is for Ward Location, call MAIN^TIUMOVE
  1. . I $P($G(^SC(+VLOC,0)),U,3)="W" D MAIN^TIUMOVE(.TIU,DFN,"",VDT,LDT,1,"LAST",0,+VLOC) Q
  1. . ; Otherwise, call MAIN^TIUVSIT
  1. . D MAIN^TIUVSIT(.TIU,DFN,"",VDT,LDT,"LAST",0,VLOC)
  1. I '+$G(TIU("VSTR")) D
  1. . D EVENT^TIUSRVP1(.TIU,DFN)
  1. S TIU("INST")=$$DIVISION^TIULC1(+TIU("LOC"))
  1. I $S($D(TIU)'>9:1,+$G(DFN)'>0:1,1:0) S SUCCESS="0^"_$$EZBLD^DIALOG(89250001) Q
  1. S TIUDA=$$GETREC(DFN,.TIU,TITLE,.NEWREC)
  1. I +TIUDA'>0 S SUCCESS="0^"_$$EZBLD^DIALOG(89250002) Q
  1. S SUCCESS=+TIUDA
  1. D STUFREC^TIUSRVP1(+TIUDA,.TIUX,DFN,,TITLE,.TIU)
  1. S:'+$G(NOASF) ^TIU(8925,"ASAVE",DUZ,TIUDA)=""
  1. K ^TIU(8925,+TIUDA,"TEMP")
  1. M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT") K TIUX("TEXT")
  1. D SETXT0(TIUDA)
  1. D FILE(.SUCCESS,+TIUDA,.TIUX,+$G(SUPPRESS))
  1. I +SUCCESS'>0 D DIK^TIURB2(TIUDA) Q
  1. I +$O(^TIU(8925,+TIUDA,"TEMP",0)) D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
  1. I +$G(TIU("STOP")) D DEFER^TIUVSIT(TIUDA,TIU("STOP")) I 1
  1. E D QUE^TIUPXAP1
  1. I '+$G(SUPPRESS) D
  1. . D RELEASE^TIUT(TIUDA,1)
  1. . D UPDTIRT^TIUDIRT(.TIU,TIUDA)
  1. K ^TIU(8925,+TIUDA,"TEMP")
  1. Q
  1. VSTRBLD(VSIT) ; Given Visit ien, build Visit-Descriptor String
  1. N TIUY,VSIT0,VLOC,VDT,VSVCAT
  1. S VSIT0=$G(^AUPNVSIT(+VSIT,0)),VDT=+$P(VSIT0,U),VLOC=+$P(VSIT0,U,22)
  1. S VSVCAT=$P(VSIT0,U,7)
  1. S TIUY=VLOC_";"_VDT_";"_VSVCAT
  1. Q TIUY
  1. SETXT0(TIUDA) ; Set root node of "TEMP" WP-field
  1. N TIUC,TIUI S (TIUC,TIUI)=0
  1. F S TIUI=$O(^TIU(8925,TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
  1. . S:$D(^TIU(8925,TIUDA,"TEMP",TIUI,0)) TIUC=TIUC+1
  1. S ^TIU(8925,TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
  1. Q
  1. MAKEADD(TIUDADD,TIUDA,TIUX,SUPPRESS) ; Create addendum
  1. ; For backward compatibility
  1. ; Use MAKEADD^TIUSRVP2 now, please
  1. D MAKEADD^TIUSRVP2(.TIUDADD,TIUDA,.TIUX,+$G(SUPPRESS))
  1. Q
  1. UPDATE(SUCCESS,TIUDA,TIUX,SUPPRESS) ; Update existing Document
  1. N TIU,TIUI,TIUC,TIUD0,TIUD12,TIUD14,TIUD15,TIUCPF,TITLE,PRFUNLNK,TIUY,TIUCC,TIUFLAG S TIUFLAG=0
  1. I $S(+$G(TIUDA)'>0:1,'$D(^TIU(8925,+TIUDA,0)):1,1:0) D Q
  1. . S SUCCESS="0^ Cannot update a non-existent document..."
  1. I +$P($G(^TIU(8925,+TIUDA,0)),U,5)>6 D Q
  1. . S SUCCESS="0^ TIU Document #"_TIUDA_" is already signed..."
  1. I $D(TIUX("TEXT")) D
  1. . K ^TIU(8925,+TIUDA,"TEMP")
  1. . M ^TIU(8925,+TIUDA,"TEMP")=TIUX("TEXT")
  1. . S (TIUC,TIUI)=0
  1. . F S TIUI=$O(^TIU(8925,+TIUDA,"TEMP",TIUI)) Q:+TIUI'>0 D
  1. . . S TIUC=TIUC+1
  1. . I +TIUC>0 S ^TIU(8925,+TIUDA,"TEMP",0)="^^"_TIUC_U_TIUC_U_DT_"^^"
  1. . K TIUX("TEXT")
  1. I +$O(TIUX(""))'>0 S:+$G(SUPPRESS) SUCCESS=+TIUDA Q
  1. S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD12=$G(^(12)),TIUD14=$G(^(14)),TITLE=+TIUD0
  1. ;Set a flag to indicate whether or not a Title is a member of the
  1. ;Clinical Procedures Class (1=Yes and 0=No)
  1. S TIUCPF=+$$ISA^TIULX(TITLE,+$$CLASS^TIUCP)
  1. D SETCOS^TIUSRVP2(TIUDA,.TIUX,TIUD0,TIUD12)
  1. ; Consult association changed? If so, rollback to Active status. VM/RJT - *239
  1. S TIUCC=$P($G(TIUD14),"^",5)
  1. I +$G(TIUX("1405"))>0,+$G(TIUCC)>0,(+$G(TIUX("1405"))'=+TIUCC) D ROLLBACK^TIUCNSLT(TIUDA) S TIUFLAG=1
  1. ; Title changed? Refile DC
  1. I +$G(TIUX(.01))>0,(+$G(TIUX(.01))'=+TIUD0) D
  1. . S TIUX(.04)=$$DOCCLASS^TIULC1(+$G(TIUX(.01)))
  1. . S TIUY=0 D ISCNSLT^TIUCNSLT(.TIUY,TITLE)
  1. . I $G(TIUY),TIUFLAG=0 D ROLLBACK^TIUCNSLT(TIUDA) ; if changed to Non-Consult title - VMP/RJT - *239
  1. . ; If change title from PRF to nonPRF, set flg to unlink note:
  1. . I $$ISPFTTL^TIUPRFL(TITLE),'$$ISPFTTL^TIUPRFL(+$G(TIUX(.01))) S PRFUNLNK=1
  1. D FILE(.SUCCESS,+TIUDA,.TIUX,+$G(SUPPRESS),TIUCPF)
  1. I +SUCCESS'>0 K ^TIU(8925,+TIUDA,"TEMP") Q
  1. I $G(PRFUNLNK) D UNLINK^TIUPRF1(TIUDA)
  1. D GETTIU^TIULD(.TIU,TIUDA)
  1. I $D(^TIU(8925,+TIUDA,"TEMP")) D
  1. . K ^TIU(8925,+TIUDA,"TEXT")
  1. . D MERGTEXT^TIUEDI1(+TIUDA,.TIU)
  1. . K ^TIU(8925,+TIUDA,"TEMP")
  1. . S:'+$G(SUCCESS) SUCCESS=+TIUDA
  1. ; If signed, re-file /ES/
  1. S TIUD15=$G(^TIU(8925,+TIUDA,15))
  1. I +TIUD15 D
  1. . N TIUBY,DR,DIE,DA,X,Y S TIUBY=$P(TIUD15,U,2) Q:+TIUBY'>0
  1. . S DR="1503///^S X=$$SIGNAME^TIULS("_TIUBY_");1504///^S X=$$SIGTITL^TIULS("_TIUBY_")"
  1. . S DA=TIUDA,DIE=8925 D ^DIE
  1. ; send alerts
  1. I '+$G(SUPPRESS) D
  1. . I +$P(TIUD0,U,5)<5,'$D(TIUX(.05)) D UPDSTAT(TIUDA,+$G(TIUD0))
  1. . D SEND^TIUALRT(TIUDA),SENDID^TIUALRT1(TIUDA):+$G(^TIU(8925,+TIUDA,21))
  1. . D UPDTIRT^TIUDIRT(.TIU,TIUDA)
  1. Q
  1. SETCOS(TIUDA,TIUX,TIUD0,TIUD12) ; set cosig req
  1. ; For backward compatibility
  1. ; Use SETCOS^TIUSRVP2 now, please
  1. D SETCOS^TIUSRVP2(TIUDA,.TIUX,TIUD0,TIUD12)
  1. Q
  1. UPDSTAT(DA,TITLE) ; Update status on commit
  1. N DR,DIE S DR=".05////"_$$STATUS^TIUSRVP1(DA,0,TITLE)
  1. I '+$P($G(^TIU(8925,DA,13)),U,4) S DR=DR_";1304////^S X=$$NOW^XLFDT"
  1. S DIE=8925
  1. D ^DIE
  1. Q
  1. GETREC(DFN,TIU,TITLE,TIUNEW) ; Get/create document record
  1. N DA,DIC,DIE,DLAYGO,DR,X,Y,TIUDPRM,TIUFPRIV,TIUHIT,TIUSCAT
  1. S (TIUHIT,DA)=0,TIUFPRIV=1
  1. S (DIC,DLAYGO)=8925,DIC(0)="FL"
  1. S X=""""_"`"_+TITLE_"""" D ^DIC K DIC("S")
  1. I +Y'>0 Q Y_U_" Insufficient data to create a new record."
  1. S DA=+Y,TIUNEW=+$P(Y,U,3)
  1. N DIE,DR,TIUVISIT S DIE=8925
  1. S TIUVISIT=$S(+$G(TIU("VISIT")):+$G(TIU("VISIT")),1:"")
  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:"")
  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)
  1. D ^DIE
  1. Q +$G(DA)
  1. FILE(SUCCESS,TIUDA,TIUX,SUPPRESS,TIUCPF) ; Call FM Filer & commit
  1. N FDA,FDARR,IENS,FLAGS,TIUMSG,TIUCMMTX
  1. S IENS=""""_TIUDA_",""",FDARR="FDA(8925,"_IENS_")",FLAGS=""
  1. I +$G(TIUX(1202)) S TIUX(1204)=+$G(TIUX(1202))
  1. I +$G(TIUX(1209)) S TIUX(1208)=+$G(TIUX(1209))
  1. ;If the document is a member of the Clinical Procedures Class, set the
  1. ;Entered By field to the Author/Dictator field
  1. I $G(TIUCPF),+$G(TIUX(1202)) S TIUX(1302)=+$G(TIUX(1202))
  1. ;*271 Prevent string date in 1301
  1. S:$G(TIUX(1301)) TIUX(1301)=+TIUX(1301)
  1. M @FDARR=TIUX
  1. D FILE^DIE(FLAGS,"FDA","TIUMSG") ; File record
  1. I $D(TIUMSG)>9 S SUCCESS=0_U_$G(TIUMSG("DIERR",1,"TEXT",1)) Q
  1. S SUCCESS=TIUDA
  1. I '+$G(SUPPRESS) D
  1. . N DA
  1. . S DA=TIUDA
  1. . S TIUCMMTX=$$COMMIT^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
  1. . I TIUCMMTX]"" X TIUCMMTX
  1. . K ^TIU(8925,"ASAVE",DUZ,TIUDA)
  1. Q
  1. SIGN(ERR,TIUDA,TIUX) ; API for /es/
  1. ; For backward compatibility
  1. ; Use SIGN^TIUSRVP2 now, please
  1. D SIGN^TIUSRVP2(.ERR,TIUDA,.TIUX)
  1. Q
  1. DELETE(ERR,TIUDA,TIURSN,OVRRIDE) ; delete document
  1. N TIUDEL,TIUD0,TIU S ERR=0
  1. I '+$G(OVRRIDE) D Q:+$G(TIUDEL)'>0
  1. . S TIUDEL=$$CANDO^TIULP(TIUDA,"DELETE RECORD")
  1. . I TIUDEL'>0 S ERR="89250003^"_$$EZBLD^DIALOG(89250003)
  1. D GETTIU^TIULD(.TIU,TIUDA)
  1. S TIUD0=$G(^TIU(8925,+TIUDA,0))
  1. I +$P(TIUD0,U,5)'<6 D Q
  1. . S TIURSN=$G(TIURSN,"A")
  1. . D DELTEXT^TIURB2(TIUDA,TIURSN)
  1. D DIK^TIURB2(TIUDA)
  1. D DELAUDIT^TIUEDI1(TIUDA)
  1. D NOTIFY^TIUUTL("DELETE",+$P(TIUD0,U,2),,.TIU,TIUDA)
  1. Q
  1. ANPKGMSG(RETURN,TIUDA,TIUACT) ; return ancillary packages' message(s)
  1. S TIUDA=+$G(TIUDA),TIUACT=$G(TIUACT)
  1. I 'TIUDA S RETURN(0)="Invalid parameter: TIUDA="_TIUDA Q
  1. I "^DELETE^REASSIGN^"'[(U_TIUACT_U) S RETURN(0)="Invalid parameter: TIUACT="""_TIUACT_""""
  1. N TIUD0,TIUJUST
  1. S TIUD0=$G(^TIU(8925,+TIUDA,0))
  1. I TIUD0="" S RETURN(0)="Invalid document number: "_TIUDA Q
  1. I TIUACT="DELETE" D
  1. .D NEEDJUST^TIUSRVA(.TIUJUST,TIUDA)
  1. .I TIUJUST S TIUACT="RETRACT"
  1. D ANPKGMSG^TIUUTL(+$P(TIUD0,U,2),+$P(TIUD0,U,3),TIUDA_U_$P($G(^TIU(8925.1,+$P(TIUD0,U),0)),U),TIUACT)
  1. N TIUAPKG,TIUMLINE,TIULINE
  1. S TIUMLINE=0
  1. S TIUAPKG="" F S TIUAPKG=$O(^TMP("TIUDOCDIS",$J,"MESSAGES",TIUAPKG)) Q:TIUAPKG="" D
  1. .S RETURN(TIUMLINE)="~NPKG"_U_TIUAPKG_":",TIUMLINE=1+TIUMLINE
  1. .S TIULINE=0 F S TIULINE=$O(^TMP("TIUDOCDIS",$J,"MESSAGES",TIUAPKG,TIULINE)) Q:'+TIULINE D
  1. ..S RETURN(TIUMLINE)=$G(^TMP("TIUDOCDIS",$J,"MESSAGES",TIUAPKG,TIULINE)),TIUMLINE=1+TIUMLINE
  1. K ^TMP("TIUDOCDIS",$J)
  1. Q
  1. LOCK(ERR,TIUDA) ; Bid for lock on a TIU Document record
  1. L +^TIU(8925,+TIUDA):1 I S ERR=0
  1. E S ERR="1^ Another session has this record locked."
  1. Q
  1. UNLOCK(ERR,TIUDA) ; Decrement Lock on a TIU Document record
  1. L -^TIU(8925,+TIUDA) S ERR=0
  1. Q