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

TIURS1.m

Go to the documentation of this file.
  1. TIURS1 ; SLC/JER - Additional /es/ actions ; 11/21/12 4:18pm
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**7,36,58,100,109,142,156,184,233,261,274**;Jun 20, 1997;Build 6
  1. ELSIG ; Sign rec
  1. N TIULST,TIUSLST,TIURJCT,TIUES,TIUI,X,X1,Y,TIUDAARY,TIUCHNG
  1. I '$D(TIUPRM0) D SETPARM^TIULE
  1. I $P(TIUPRM0,U,2)'>0 W !,"Electronic signature not yet enabled." H 3 G ELSIGX
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0 I $D(VALMY)>9 D CLEAR^VALM1
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D
  1. . N TIU0,TIU12,TIUSTAT,TIUEVNT,TIUTYPE,TIUPOP,TIU15,TIUDPRM
  1. . N ASK,SIGNER,COSIGNER,XTRASGNR,TIUDATA,TIUDA,RSTRCTD
  1. . S (ASK,TIUPOP)=0
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . S TIUDA=$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
  1. . I RSTRCTD D Q
  1. . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S TIU0=$G(^TIU(8925,+TIUDA,0)),TIU12=$G(^(12)),TIU15=$G(^(15))
  1. . S SIGNER=$S(+$P(TIU12,U,4):$P(TIU12,U,4),1:$P(TIU12,U,2))
  1. . S COSIGNER=$P(TIU12,U,8)
  1. . I (DUZ'=SIGNER),(DUZ'=COSIGNER) S XTRASGNR=+$O(^TIU(8925.7,"AE",+TIUDA,+DUZ,0))
  1. . S TIUSTAT=+$P(TIU0,U,5)
  1. . S TIUTYPE=$$PNAME^TIULC1(+TIU0)
  1. . S TIUEVNT=$S(TIUSTAT'>5:"SIGNATURE",+$G(XTRASGNR):"SIGNATURE",1:"COSIGNATURE")
  1. . D DOCPRM^TIULC1(+TIU0,.TIUDPRM,TIUDA)
  1. . S ASK=$$CANDO^TIULP(TIUDA,TIUEVNT)
  1. . I +ASK>0 D
  1. . . L +^TIU(8925,+TIUDA):1
  1. . . E S ASK="0^ Another user is editing this entry."
  1. . I +ASK'>0,$P(ASK,U,2)]"" D I 1
  1. . . D FULL^VALM1
  1. . . W !!,"Item #",TIUI,": ",$P(ASK,U,2),! K VALMY(TIUI)
  1. . . W !,"Removed from signature list.",!
  1. . . I $$READ^TIUU("FOA","Press RETURN to continue...")
  1. . E D
  1. . . ;If document is a clinical procedures title AND (P184) this is not an additional signature, check if clinical
  1. . . ;procedure fields are required. If the fields are required, prompt for
  1. . . ;them and don't permit the user to sign unless the fields are defined.
  1. . . I '$G(XTRASGNR),+$$ISA^TIULX(+TIU0,+$$CLASS^TIUCP),$$REQCPF^TIULP(+$P($G(^TIU(8925,+TIUDA,14)),U,5)) D Q:+TIUPOP
  1. . . . N TIUCPFLD
  1. . . . W !!,"Item #",TIUI,": ",TIUTYPE," for "
  1. . . . W $$PTNAME^TIULC1($P(TIU0,U,2))," will need Procedure Summary Code and Date/Time Performed..."
  1. . . . I $G(^TIU(8925,+TIUDA,702)),$P(^(702),U)]"",$P(^(702),U,2)]"" S TIUCPFLD=1 Q
  1. . . . S TIUCPFLD=$$ASKCPF^TIURS(TIUDA)
  1. . . . I +TIUCPFLD'>0 D
  1. . . . . S TIUPOP=1
  1. . . . . W !!,"Item #",TIUI,": MUST have a Procedure Summary Code and Date/Time Performed",!,"before you may sign."
  1. . . . . W !!,"Removed from signature list.",!
  1. . . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
  1. . . ; VMP/RJT - *233
  1. . . I $S(+$$REQCOSIG^TIULP(+TIU0,+TIUDA,DUZ):1,+$P(TIU15,U,6):1,1:0),(+$P(TIU12,U,8)'>0),'+$G(XTRASGNR) D Q:+TIUPOP
  1. . . . N COSIGNER
  1. . . . W !!,"Item #",TIUI,": ",TIUTYPE," for "
  1. . . . W $$PTNAME^TIULC1($P(TIU0,U,2))," will need cosignature..."
  1. . . . S COSIGNER=$$ASKCSNR^TIURS(TIUDA,DUZ)
  1. . . . I +COSIGNER'>0 D
  1. . . . . S TIUPOP=1
  1. . . . . W !!,"Item #",TIUI,": MUST have a cosigner, before you may sign."
  1. . . . . W !!,"Removed from signature list.",!
  1. . . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
  1. . . ; TIU*1.0*274 DJH Do not allow notes without any text to be signed
  1. . . I $$EMPTYDOC^TIULF(+TIUDA) D Q
  1. . . . W !!,"Item #",TIUI,": This note contains no text and cannot be signed."
  1. . . . W !!,"Removed from signature list.",!
  1. . . . I $$READ^TIUU("FOA","Press RETURN to continue...")
  1. . . N TIU,TIUY
  1. . . D EN^VALM("TIU SIGN/COSIGN")
  1. I $D(TIUSLST)'>9 D G ELSIGX
  1. . S VALMSG="** Signature List Empty...Nothing signed. **"
  1. I $D(TIUSLST)>9 D
  1. . N TIUIO
  1. . S TIUES=$$ASKSIG^TIULA1
  1. . I '+TIUES S VALMSG="** Nothing Signed. **" D FIXLSTNW^TIULM Q
  1. . D FULL^VALM1
  1. . D MULTIPRN(.TIUSLST,.TIUIO)
  1. . S TIUI=0 F S TIUI=$O(TIUSLST(TIUI)) Q:+TIUI'>0 D
  1. . . N TIUPY,XTRASGNR
  1. . . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI)),TIUDA=$P(TIUDATA,U,2)
  1. . . S TIUDAARY(TIUI)=TIUDA
  1. . . S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
  1. . . S XTRASGNR=+$P(TIUSLST(TIUI),U,3)
  1. . . I +$G(XTRASGNR) D ADDSIG^TIURS1(TIUDA,XTRASGNR)
  1. . . I '+$G(XTRASGNR) D ES^TIURS(TIUDA,TIUES)
  1. . . I +TIUSLST(TIUI),(TIUIO]"") D RPC^TIUPD(.TIUPY,TIUDA,TIUIO,$P(TIUSLST(TIUI),U,2))
  1. . D FULL^VALM1
  1. ELSIGX I $G(TIUCHNG("ADDM"))!$G(TIUCHNG("DELETE")) S TIUCHNG("RBLD")=1
  1. E S TIUCHNG("UPDATE")=1
  1. M TIUVALMY=VALMY D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) K VALMY,TIUVALMY
  1. S VALMBCK="R"
  1. D VMSG($G(TIULST),.TIUDAARY,"signed")
  1. Q
  1. VMSG(TIULST,TIUDAARY,ACTION) ; Set VALMSG for messagebar, bold changed items
  1. N TIUI,LINENO,ACTFIRST
  1. S ACTFIRST=$S(ACTION="Encounter Data Edited":1,ACTION="Signers identified/edited":1,ACTION="Title changed":1,1:0)
  1. I TIULST']"" D Q
  1. . I ACTFIRST S VALMSG="** No changes made. **" Q
  1. . S VALMSG="** Nothing "_ACTION_". **"
  1. I ACTION="copied" S ACTION="copied; See end of list"
  1. S TIULST=$$NEWLST(TIULST,.TIUDAARY)
  1. I TIULST]"" D
  1. . I ACTFIRST D Q
  1. . . S VALMSG="** "_ACTION_" for item"_$S($L(TIULST,",")>1:"s ",$L(TIULST,"-")>1:"s ",1:" ")_TIULST_". **"
  1. . S VALMSG="** Item"_$S($L(TIULST,",")>1:"s ",$L(TIULST,"-")>1:"s ",1:" ")_TIULST_" "_ACTION_". **"
  1. I TIULST']"" D
  1. . I ACTFIRST D Q
  1. . . S VALMSG="** "_ACTION_"; item(s) no longer in list. **"
  1. . S VALMSG="** Item"_$S($L(TIULST,",")>1:"s ",$L(TIULST,"-")>1:"s ",1:" ")_TIULST_" "_ACTION_", no longer in list. **"
  1. . ;S VALMSG="** Item(s) "_ACTION_", no longer in list. **"
  1. Q:$G(^TMP("TIUR",$J,"RTN"))="TIUROR"
  1. F TIUI=1:1 S LINENO=$P(TIULST,", ",TIUI) Q:'LINENO D
  1. . D CNTRL^VALM10(LINENO,1,$G(VALM("RM")),IOINHI,IOINORM)
  1. Q
  1. NEWLST(TIULST,TIUDAARY) ; Return TIULST with updated item numbers
  1. N TIUI,TIULNO,TIUDA,TIUNLNO,TIUNLST
  1. S TIUNLST=""
  1. F TIUI=1:1 S TIULNO=$P(TIULST,",",TIUI) Q:'TIULNO D
  1. . S TIUDA=TIUDAARY(TIULNO),TIUNLNO=$O(^TMP("TIUR",$J,"IEN",TIUDA,0))
  1. . I TIUNLNO S TIUNLST=$G(TIUNLST)_$S($G(TIUNLST)]"":", ",1:"")_TIUNLNO
  1. Q TIUNLST
  1. ;
  1. MULTIPRN(TIUSLST,TIUIO) ; ask device
  1. N TIUI,TIUASK,TIUION,TIUPOK,IO,TIUPLIST,TIUSCRN S (TIUI,TIUPOK)=0
  1. F S TIUI=$O(TIUSLST(TIUI)) Q:TIUI'>0!+TIUPOK S:+TIUSLST(TIUI) TIUPOK=1
  1. I '+TIUPOK S TIUIO="" Q
  1. S TIUPLIST=$$LIST(.TIUSLST)
  1. W !!,"Please specify the device for printing item"
  1. W $S(TIUPLIST[",":"s",TIUPLIST["-":"s",1:""),": ",TIUPLIST,!!
  1. S TIUSCRN="I $L($G(^%ZIS(1,+Y,""TYPE""))),("";HFS;MT;BAR;VTRM;RES;CHAN;IMPC;""'[("";""_^(""TYPE"")_"";""))"
  1. S TIUION=$$DEVICE^TIUDEV(.TIUIO,"LAST","N",TIUSCRN,"Q")
  1. I '$L(TIUION) S TIUIO=""
  1. D ^%ZISC
  1. Q
  1. LIST(LIST) ; build print list
  1. N TIUY,TIUI S TIUI=0
  1. F S TIUI=$O(LIST(TIUI)) Q:+TIUI'>0 D
  1. . S:+LIST(TIUI) TIUY=$G(TIUY)_$S($G(TIUY)]"":", ",1:"")_TIUI
  1. Q $G(TIUY)
  1. ;
  1. ADDSIG(TIUDA,DA) ; Apply extra signatures to a document
  1. N DIE,DR
  1. S DIE=8925.7
  1. S DR=".04////"_$$NOW^TIULC_";.05////"_DUZ_";.06///^S X=$$SIGNAME^TIULS("_DUZ_");.07///^S X=$$SIGTITL^TIULS("_DUZ_");.08////E"
  1. D ^DIE
  1. D SEND^TIUALRT(TIUDA)
  1. Q
  1. CNVPOST ; Change Titles/Convert Postings
  1. N TIUI,TIULST,Y,TIUVIEW,TIUCHNG,TIUDAARY,DIROUT
  1. I $G(TIUGLINK) W !,"Please finish attaching the interdisciplinary note before changing title.",! H 3 Q
  1. I '$D(VALMY) D EN^VALM2(XQORNOD(0))
  1. S TIUI=0
  1. I +$O(VALMY(0)) D FULL^VALM1
  1. F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
  1. . N TIU,TIUDA,DFN,TIUDATA,VALMY,XQORM,TIUVIEW,RSTRCTD
  1. . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
  1. . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
  1. . I RSTRCTD D Q
  1. . . W !!,$C(7),"Ok, no harm done...",! ; Echo denial message
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
  1. . I +TIUVIEW'>0 D Q ; Exclude records user can't view
  1. . . W !!,$C(7),$P(TIUVIEW,U,2),! ; Echo denial message
  1. . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. . S TIUCHNG=0
  1. . D EN^VALM("TIU CHANGE TITLE")
  1. . S TIUDAARY(TIUI)=TIUDA
  1. . I +$G(TIUCHNG) S TIULST=$G(TIULST)_$S($G(TIULST)]"":",",1:"")_TIUI
  1. ; -- Update list: --
  1. S TIUCHNG("UPDATE")=1 M TIUVALMY=VALMY
  1. D UPRBLD^TIURL(.TIUCHNG,.TIUVALMY) K VALMY,TIUVALMY
  1. S VALMBCK="R"
  1. D VMSG($G(TIULST),.TIUDAARY,"Title changed")
  1. Q
  1. CNVPOST1 ; Convert Single Posting to another title
  1. N TIUD0,DIE,DR,TIUTITL,CHKSUM,TIUCHTTL,TIUCLSS,TIUCON,TIUQUIT
  1. N DA,X,Y
  1. N TIUCHNGD ;261
  1. ; Added TIUCON for **142
  1. S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUCHNG=0
  1. ; Added TIUNOCS for **142
  1. D FULL^VALM1
  1. I +TIUD0=81 S TIUCHTTL="0^You may not change the TITLE of an ADDENDUM."
  1. I '$D(TIUCHTTL) S TIUCHTTL=$$CANDO^TIULP(TIUDA,"CHANGE TITLE")
  1. I +TIUCHTTL,$$DADORKID^TIUGBR(TIUDA) S TIUCHTTL="0^Interdisciplinary entries must be detached before changing titles." ;**100
  1. I +TIUCHTTL'>0 D Q
  1. . W !!,$C(7),$P(TIUCHTTL,U,2),! ; Echo denial
  1. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. L +^TIU(8925,TIUDA,0):1
  1. E D Q
  1. . W !!?5,$C(7),"Another user is editing this entry.",! ; Echo denial
  1. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
  1. S TIUTITL=$$ASKTITLE^TIULA3(+$$CLINDOC^TIULC1(+TIUD0,TIUDA),+TIUD0)
  1. S TIUCLSS=$$CLASS^TIUCNSLT()
  1. S TIUCON=+$$ISA^TIULX(TIUTITL,TIUCLSS)
  1. I TIUCON=1,+TIUD0'=TIUTITL D CHANGE^TIUCNSLT(TIUDA,"",.TIUNOCS)
  1. I $G(TIUNOCS)=-1 D G POST1Q
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; **142
  1. ;*184->
  1. D CONSCT^TIUCNSLT(TIUDA,+TIUD0,TIUTITL)
  1. D PRFCT^TIUPRF1(+TIUD0,TIUTITL,TIUDA)
  1. ;<-*184
  1. I $G(TIUQUIT)=1 G POST1Q
  1. D WTRMARK^TIURB3(TIUDA,TIUTITL,.TIUCHNGD) I $G(TIUQUIT)=1 G POST1Q ;261
  1. I 'TIUCHNGD D TLDIE(TIUDA,TIUTITL)
  1. I +$G(^TIU(8925,+TIUDA,0))'=+TIUD0 S TIUCHNG=1
  1. S CHKSUM=+$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")")
  1. D AUDIT^TIUEDI1(TIUDA,CHKSUM,CHKSUM)
  1. POST1Q ;clean up, linetag put in with *171
  1. L -^TIU(8925,TIUDA,0)
  1. K TIUNOCS
  1. Q
  1. ;
  1. TLDIE(DA,TIUTITL) ; Change title of DA to TIUTITL
  1. N DIE,DR S DIE=8925
  1. S DR=".01////^S X="_TIUTITL_";.04////^S X="_$$DOCCLASS^TIULC1(TIUTITL)
  1. D ^DIE
  1. Q