TIUSRV ; SLC/JER - Silent server functions ;08/13/13 16:22
;;1.0;TEXT INTEGRATION UTILITIES;**1,19,28,87,61,100,109,113,112,184,211,250,263**;Jun 20, 1997;Build 16
;
; ICR #10088 - ENDR^%ZISS Routine & IOINORM, IORVOFF, IORVON Local Vars
; #10015 - EN^DIQ1 Routine & DA, DIC,DIQ, & DR Local Vars
; #10116 - $$SETSTR^VALM1
; #10117 - CNTRL^VALM10,SET^VALM10 & VALM("LINES"), VALMAR, VALMCNT,
; VALMEVL, & VALMQUIT Local Vars
; #10104 - $$UP^XLFSTR
;
RPC(TIUY,TIUDA,REASSIGN) ; RPC for DT
N VALMAR,TIUGDATA,TIUGWHOL K ^TMP("TIUAUDIT",$J)
S TIUY=$NA(^TMP("TIUAUDIT",$J))
D GET(TIUDA,1,+$G(REASSIGN))
K ^TMP("VALM VIDEO",$J)
Q
GET(TIUDA,HUSH,REASSIGN) ; Build List
N TIUI,TIUL,TIUREC,TIUDADD,X,TIUCPF,ONBROWSE
S (TIUDADD,TIUI,VALMCNT)=0,HUSH=+$G(HUSH)
N DA,DIC,DIQ,DR,TIUNAME K ^TMP("TIUAUDIT",$J)
I '$D(TIUPRM0) D SETPARM^TIULE
I '$D(IOINORM) S X="IOINORM;IOIHI;IORVON;IORVOFF;IOUON;IOUOFF;IOBON;IOBOFF" D ENDR^%ZISS
S:'$D(VALMAR) VALMAR="^TMP(""TIUAUDIT"",$J)"
S VALMEVL=+$G(VALMEVL)
I '$D(^TIU(8925,+TIUDA,0)) S VALMQUIT=1 Q
; if the document has an OnBrowse Event, execute it
S ONBROWSE=$$ONBROWSE^TIULC1(+$G(^TIU(8925,+TIUDA,0)))
I $L(ONBROWSE) D LOADSUPP(ONBROWSE,TIUDA,.VALMCNT)
;Set a flag to indicate whether or not a Title is a member of the
;Clinical Procedures Class (1=Yes and 0=No)
S TIUCPF=+$$ISA^TIULX(+$G(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
S DIC=8925,DIQ="TIUREC(",DA=TIUDA
S DR=".01;.02;.05;.07:.1;1201;1202;1204;1208;1212;1301;1302;1305;1306;1501;1502;1505;1507;1508;1511;1601:1602;1610:1612;1701;1801;89261"
;If the document is a member of the Clinical Procedures Class, include the
;Procedure Summary Code field and the Date/Time Performed field
I TIUCPF S DR=DR_";70201;70202"
D EN^DIQ1
S TIUI="" F S TIUI=$O(TIUREC(8925,+TIUDA,TIUI)) Q:+TIUI'>0 D
. I $G(TIUREC(8925,+TIUDA,TIUI))']"" S TIUREC(8925,+TIUDA,TIUI)="None"
. E S TIUREC(8925,+TIUDA,TIUI)=$$UP^XLFSTR(TIUREC(8925,+TIUDA,TIUI))
I $D(TIUREC)>9 D
. D SOURCE(.TIUREC,HUSH,.VALMCNT,TIUCPF)
. I '+$G(REASSIGN) D PROBLEM(TIUDA,.VALMCNT) D:$$ISPRFDOC^TIUPRF(TIUDA) LKDETAIL^TIUPRF3(TIUDA,.VALMCNT) D EDIT(TIUDA,.VALMCNT)
. D REASSIGN^TIUSRV1(TIUDA,+$G(REASSIGN),.VALMCNT) Q:+$G(REASSIGN)
. D IDLINK^TIUSRV1(TIUDA,.VALMCNT)
. D SIGN(.TIUREC,.VALMCNT)
. I +$O(^TIU(8925.7,"B",TIUDA,0)) D XTRASIGN(TIUDA,.VALMCNT)
. I $D(^TIU(8925,+TIUDA,16)) D PRIVACY(.TIUREC,.VALMCNT)
. D BODY(TIUDA,.VALMCNT)
S:+$G(VALMCNT)<$G(VALM("LINES")) VALMCNT=$G(VALM("LINES"))
Q
LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
N TIUY,TIUI S TIUI=0
X METHOD I '$D(@TIUY) Q
S TIUL=TIUL+1
D SET(TIUL,1,"Requesting Package Information ",$G(IORVON),$G(IORVOFF))
S TIUL=TIUL+1 D BLANK(TIUL)
F S TIUI=$O(@TIUY@(TIUI)) Q:+TIUI'>0 D
. S TIUL=+$G(TIUL)+1 D SET(TIUL,1,@TIUY@(TIUI))
S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
K @TIUY
Q
SOURCE(TIUREC,HUSH,TIUL,TIUCPF) ; Source Info
W:'+$G(HUSH) !!,"Opening "_TIUREC(8925,+TIUDA,.01)_" record for review..."
S TIUL=TIUL+1
D SET(TIUL,1,"Source Information ",$G(IORVON),$G(IORVOFF))
D SET(TIUL+1,2," Standard Title: "_$G(TIUREC(8925,TIUDA,89261)))
D SET(TIUL+2,2," Reference Date: "_$G(TIUREC(8925,TIUDA,1301)))
D SET(TIUL+3,2," Entry Date: "_$G(TIUREC(8925,TIUDA,1201)))
D SET(TIUL+4,2,"Expected Signer: "_$G(TIUREC(8925,TIUDA,1204)))
D SET(TIUL+5,2," Urgency: "_$G(TIUREC(8925,TIUDA,.09)))
D SET(TIUL+6,2," Line Count: "_$G(TIUREC(8925,TIUDA,.1)))
D SET(TIUL+7,2," Division: "_$G(TIUREC(8925,TIUDA,1212)))
D SET(TIUL+8,2," Subject: "_$G(TIUREC(8925,TIUDA,1701)))
;If the document is a member of the Clinical Procedures Class, include the
;Procedure Summary Code field and the Date/Time Performed field
I $G(TIUCPF) D
. D BLANK(TIUL+9)
. D SET(TIUL+10,2,"Procedure Summary Code: "_$G(TIUREC(8925,TIUDA,70201)))
. D SET(TIUL+11,2," Date/Time Performed: "_$G(TIUREC(8925,TIUDA,70202)))
D SET(TIUL+1,40," Author: "_$G(TIUREC(8925,TIUDA,1202)))
D SET(TIUL+2,40," Entered By: "_$G(TIUREC(8925,TIUDA,1302)))
D SET(TIUL+3,40," Expected Cosigner: "_$G(TIUREC(8925,TIUDA,1208)))
D SET(TIUL+4,40," Document Status: "_$G(TIUREC(8925,TIUDA,.05)))
D SET(TIUL+5,40," TIU Document #: "_+$G(TIUDA))
D SET(TIUL+6,40," VBC Line Count: "_$G(TIUREC(8925,TIUDA,1801)))
S TIUL=$S(+$G(TIUCPF):TIUL+11,1:TIUL+8)
Q
PROBLEM(TIUDA,TIUL) ; Problems
N TIUI,DR,DA,DIC,DIQ,TIUPROB,TIUNARR,TIUNARR1,TIUNARR2,TIUPB S TIUI=0
S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
D SET(TIUL,1,"Associated Problems ",$G(IORVON),$G(IORVOFF))
I '+$O(^TIU(8925.9,"B",+TIUDA,0)) D SET(TIUL,25,"No linked problems.")
F S TIUI=$O(^TIU(8925.9,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
. S DA=TIUI,DR=".02;.05",DIC="^TIU(8925.9,",DIQ="TIUPROB"
. D EN^DIQ1 Q:$D(TIUPROB)'>9
. S TIUL=TIUL+1
. S TIUNARR=$G(TIUPROB(8925.9,TIUI,.05))
. S TIUNARR1=$P(TIUNARR,"("),TIUNARR2=$P(TIUNARR,TIUNARR1,2)
. S TIUNARR=$$MIXED^TIULS(TIUNARR1)_TIUNARR2
. S TIUNARR=$E(TIUNARR,1,54)
. D SET(TIUL,5,TIUNARR)
. S TIUPB=$G(TIUPROB(8925.9,TIUI,.02))
. S TIUPB="(ICD-9-CM "_TIUPB_")"
. D SET(TIUL,61,TIUPB)
Q
EDIT(TIUDA,TIUL) ; Edits
N TIUI,DR,DA,DIC,DIQ,TIUED S TIUI=0
S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
D SET(TIUL,1,"Edit Information ",$G(IORVON),$G(IORVOFF))
I '+$O(^TIU(8925.5,"B",+TIUDA,0)) D SET(TIUL,22,"No edits since entry.")
F S TIUI=$O(^TIU(8925.5,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
. S DA=TIUI,DR=".02:03",DIC="^TIU(8925.5,",DIQ="TIUED"
. D EN^DIQ1 Q:$D(TIUED)'>9!($G(TIUED(8925.5,TIUI,.02))']"")
. S TIUL=TIUL+1
. D SET(TIUL,2," Edit Date: "_$G(TIUED(8925.5,TIUI,.02)))
. D SET(TIUL,44," Edited By: "_$G(TIUED(8925.5,TIUI,.03)))
Q
SIGN(TIUREC,TIUL) ; Signature
S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
D SET(TIUL,1,"Signature Information ",$G(IORVON),$G(IORVOFF))
D SET(TIUL+1,2," Signed Date: "_$G(TIUREC(8925,TIUDA,1501)))
D SET(TIUL+3,2," Cosigned Date: "_$G(TIUREC(8925,TIUDA,1507)))
D SET(TIUL+1,40," Signed By: "_$G(TIUREC(8925,TIUDA,1502)))
D SET(TIUL+2,40," Signature Mode: "_$G(TIUREC(8925,TIUDA,1505)))
D SET(TIUL+3,40," Cosigned By: "_$G(TIUREC(8925,TIUDA,1508)))
D SET(TIUL+4,40," Cosignature Mode: "_$G(TIUREC(8925,TIUDA,1511)))
S TIUL=TIUL+4
Q
XTRASIGN(TIUDA,TIUL) ; Additional signers
N TIUI,DA,DR,DIC,DIQ,TIUXTRA
S TIUI=0
S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
D SET(TIUL,1,"Receipt Acknowledged By ",$G(IORVON),$G(IORVOFF))
F S TIUI=$O(^TIU(8925.7,"B",TIUDA,TIUI)) Q:+TIUI'>0 D
. S DA=TIUI,DR=".03:.08",DIC="^TIU(8925.7,",DIQ="TIUXTRA"
. D EN^DIQ1 Q:$D(TIUXTRA)'>9
. S TIUL=TIUL+1
. D SET(TIUL,2," Signed Date: "_$G(TIUXTRA(8925.7,DA,.04)))
. D SET(TIUL,40," Signed By: "_$G(TIUXTRA(8925.7,DA,.06)))
. S TIUL=TIUL+1
. D SET(TIUL,2,"Expected Signer: "_$G(TIUXTRA(8925.7,DA,.03)))
. D SET(TIUL,40," Signature Mode: "_$G(TIUXTRA(8925.7,DA,.08)))
Q
PRIVACY(TIUREC,TIUL) ; Privacy Act
S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
D SET(TIUL,1,"Privacy Act Information ",$G(IORVON),$G(IORVOFF))
S TIUL=TIUL+1
D SET(TIUL,2," Amended Date: "_$G(TIUREC(8925,TIUDA,1601)))
D SET(TIUL,40," Amended By: "_$G(TIUREC(8925,TIUDA,1602)))
S TIUL=TIUL+1
D SET(TIUL,2," Deleted Date: "_$G(TIUREC(8925,TIUDA,1611)))
D SET(TIUL,40," Deleted By: "_$G(TIUREC(8925,TIUDA,1610)))
S TIUL=TIUL+1
D SET(TIUL,2," Reason: "_$G(TIUREC(8925,TIUDA,1612)))
Q
BODY(TIUDA,TIUL) ; body of document
N CANSEE
S TIUL=TIUL+1 D BLANK(TIUL) S TIUL=TIUL+1
D SET(TIUL,1,"Document Body ",$G(IORVON),$G(IORVOFF))
S TIUL=TIUL+1 D BLANK(TIUL)
S CANSEE=$$CANDO^TIULP(TIUDA,"VIEW")
I '+CANSEE D NOSEE(CANSEE,.TIUL) Q
I '$D(TIUGDATA) S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
D LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
K ^TMP("TIU ADDENDUM",$J)
Q
ISCOMP(DA) ; Evaluate whether a given record is a component
N TIUY,TIUTYP
S TIUTYP=+$G(^TIU(8925,DA,0))
S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
Q TIUY
NOSEE(CANSEE,TIUJ) ; When the user shouldn't see the data...
S TIUJ=+$G(TIUJ)+1
D SET(TIUJ,2,$P(CANSEE,U,2))
Q
SET(TIULINE,TIUCOL,TIUTEXT,ON,OFF) ; set display info in array
D:'$D(@VALMAR@(TIULINE,0)) BLANK(.TIULINE)
D SET^VALM10(.TIULINE,$$SETSTR^VALM1(.TIUTEXT,@VALMAR@(TIULINE,0),.TIUCOL,$L(TIUTEXT)))
D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.TIULINE,.TIUCOL,$L(TIUTEXT),$G(ON),$G(OFF))
W:'(TIULINE#5)&'+$G(HUSH) "."
Q
;
BLANK(TIULINE) ; blank line
D SET^VALM10(.TIULINE,$J("",80))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUSRV 8646 printed Dec 13, 2024@02:45:41 Page 2
TIUSRV ; SLC/JER - Silent server functions ;08/13/13 16:22
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,19,28,87,61,100,109,113,112,184,211,250,263**;Jun 20, 1997;Build 16
+2 ;
+3 ; ICR #10088 - ENDR^%ZISS Routine & IOINORM, IORVOFF, IORVON Local Vars
+4 ; #10015 - EN^DIQ1 Routine & DA, DIC,DIQ, & DR Local Vars
+5 ; #10116 - $$SETSTR^VALM1
+6 ; #10117 - CNTRL^VALM10,SET^VALM10 & VALM("LINES"), VALMAR, VALMCNT,
+7 ; VALMEVL, & VALMQUIT Local Vars
+8 ; #10104 - $$UP^XLFSTR
+9 ;
RPC(TIUY,TIUDA,REASSIGN) ; RPC for DT
+1 NEW VALMAR,TIUGDATA,TIUGWHOL
KILL ^TMP("TIUAUDIT",$JOB)
+2 SET TIUY=$NAME(^TMP("TIUAUDIT",$JOB))
+3 DO GET(TIUDA,1,+$GET(REASSIGN))
+4 KILL ^TMP("VALM VIDEO",$JOB)
+5 QUIT
GET(TIUDA,HUSH,REASSIGN) ; Build List
+1 NEW TIUI,TIUL,TIUREC,TIUDADD,X,TIUCPF,ONBROWSE
+2 SET (TIUDADD,TIUI,VALMCNT)=0
SET HUSH=+$GET(HUSH)
+3 NEW DA,DIC,DIQ,DR,TIUNAME
KILL ^TMP("TIUAUDIT",$JOB)
+4 IF '$DATA(TIUPRM0)
DO SETPARM^TIULE
+5 IF '$DATA(IOINORM)
SET X="IOINORM;IOIHI;IORVON;IORVOFF;IOUON;IOUOFF;IOBON;IOBOFF"
DO ENDR^%ZISS
+6 if '$DATA(VALMAR)
SET VALMAR="^TMP(""TIUAUDIT"",$J)"
+7 SET VALMEVL=+$GET(VALMEVL)
+8 IF '$DATA(^TIU(8925,+TIUDA,0))
SET VALMQUIT=1
QUIT
+9 ; if the document has an OnBrowse Event, execute it
+10 SET ONBROWSE=$$ONBROWSE^TIULC1(+$GET(^TIU(8925,+TIUDA,0)))
+11 IF $LENGTH(ONBROWSE)
DO LOADSUPP(ONBROWSE,TIUDA,.VALMCNT)
+12 ;Set a flag to indicate whether or not a Title is a member of the
+13 ;Clinical Procedures Class (1=Yes and 0=No)
+14 SET TIUCPF=+$$ISA^TIULX(+$GET(^TIU(8925,TIUDA,0)),+$$CLASS^TIUCP)
+15 SET DIC=8925
SET DIQ="TIUREC("
SET DA=TIUDA
+16 SET DR=".01;.02;.05;.07:.1;1201;1202;1204;1208;1212;1301;1302;1305;1306;1501;1502;1505;1507;1508;1511;1601:1602;1610:1612;1701;1801;89261"
+17 ;If the document is a member of the Clinical Procedures Class, include the
+18 ;Procedure Summary Code field and the Date/Time Performed field
+19 IF TIUCPF
SET DR=DR_";70201;70202"
+20 DO EN^DIQ1
+21 SET TIUI=""
FOR
SET TIUI=$ORDER(TIUREC(8925,+TIUDA,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+22 IF $GET(TIUREC(8925,+TIUDA,TIUI))']""
SET TIUREC(8925,+TIUDA,TIUI)="None"
+23 IF '$TEST
SET TIUREC(8925,+TIUDA,TIUI)=$$UP^XLFSTR(TIUREC(8925,+TIUDA,TIUI))
End DoDot:1
+24 IF $DATA(TIUREC)>9
Begin DoDot:1
+25 DO SOURCE(.TIUREC,HUSH,.VALMCNT,TIUCPF)
+26 IF '+$GET(REASSIGN)
DO PROBLEM(TIUDA,.VALMCNT)
if $$ISPRFDOC^TIUPRF(TIUDA)
DO LKDETAIL^TIUPRF3(TIUDA,.VALMCNT)
DO EDIT(TIUDA,.VALMCNT)
+27 DO REASSIGN^TIUSRV1(TIUDA,+$GET(REASSIGN),.VALMCNT)
if +$GET(REASSIGN)
QUIT
+28 DO IDLINK^TIUSRV1(TIUDA,.VALMCNT)
+29 DO SIGN(.TIUREC,.VALMCNT)
+30 IF +$ORDER(^TIU(8925.7,"B",TIUDA,0))
DO XTRASIGN(TIUDA,.VALMCNT)
+31 IF $DATA(^TIU(8925,+TIUDA,16))
DO PRIVACY(.TIUREC,.VALMCNT)
+32 DO BODY(TIUDA,.VALMCNT)
End DoDot:1
+33 if +$GET(VALMCNT)<$GET(VALM("LINES"))
SET VALMCNT=$GET(VALM("LINES"))
+34 QUIT
LOADSUPP(METHOD,TIUDA,TIUL) ; Execute OnBrowse/Load Supplementary data
+1 NEW TIUY,TIUI
SET TIUI=0
+2 XECUTE METHOD
IF '$DATA(@TIUY)
QUIT
+3 SET TIUL=TIUL+1
+4 DO SET(TIUL,1,"Requesting Package Information ",$GET(IORVON),$GET(IORVOFF))
+5 SET TIUL=TIUL+1
DO BLANK(TIUL)
+6 FOR
SET TIUI=$ORDER(@TIUY@(TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+7 SET TIUL=+$GET(TIUL)+1
DO SET(TIUL,1,@TIUY@(TIUI))
End DoDot:1
+8 SET TIUL=TIUL+1
DO BLANK(TIUL)
SET TIUL=TIUL+1
+9 KILL @TIUY
+10 QUIT
SOURCE(TIUREC,HUSH,TIUL,TIUCPF) ; Source Info
+1 if '+$GET(HUSH)
WRITE !!,"Opening "_TIUREC(8925,+TIUDA,.01)_" record for review..."
+2 SET TIUL=TIUL+1
+3 DO SET(TIUL,1,"Source Information ",$GET(IORVON),$GET(IORVOFF))
+4 DO SET(TIUL+1,2," Standard Title: "_$GET(TIUREC(8925,TIUDA,89261)))
+5 DO SET(TIUL+2,2," Reference Date: "_$GET(TIUREC(8925,TIUDA,1301)))
+6 DO SET(TIUL+3,2," Entry Date: "_$GET(TIUREC(8925,TIUDA,1201)))
+7 DO SET(TIUL+4,2,"Expected Signer: "_$GET(TIUREC(8925,TIUDA,1204)))
+8 DO SET(TIUL+5,2," Urgency: "_$GET(TIUREC(8925,TIUDA,.09)))
+9 DO SET(TIUL+6,2," Line Count: "_$GET(TIUREC(8925,TIUDA,.1)))
+10 DO SET(TIUL+7,2," Division: "_$GET(TIUREC(8925,TIUDA,1212)))
+11 DO SET(TIUL+8,2," Subject: "_$GET(TIUREC(8925,TIUDA,1701)))
+12 ;If the document is a member of the Clinical Procedures Class, include the
+13 ;Procedure Summary Code field and the Date/Time Performed field
+14 IF $GET(TIUCPF)
Begin DoDot:1
+15 DO BLANK(TIUL+9)
+16 DO SET(TIUL+10,2,"Procedure Summary Code: "_$GET(TIUREC(8925,TIUDA,70201)))
+17 DO SET(TIUL+11,2," Date/Time Performed: "_$GET(TIUREC(8925,TIUDA,70202)))
End DoDot:1
+18 DO SET(TIUL+1,40," Author: "_$GET(TIUREC(8925,TIUDA,1202)))
+19 DO SET(TIUL+2,40," Entered By: "_$GET(TIUREC(8925,TIUDA,1302)))
+20 DO SET(TIUL+3,40," Expected Cosigner: "_$GET(TIUREC(8925,TIUDA,1208)))
+21 DO SET(TIUL+4,40," Document Status: "_$GET(TIUREC(8925,TIUDA,.05)))
+22 DO SET(TIUL+5,40," TIU Document #: "_+$GET(TIUDA))
+23 DO SET(TIUL+6,40," VBC Line Count: "_$GET(TIUREC(8925,TIUDA,1801)))
+24 SET TIUL=$SELECT(+$GET(TIUCPF):TIUL+11,1:TIUL+8)
+25 QUIT
PROBLEM(TIUDA,TIUL) ; Problems
+1 NEW TIUI,DR,DA,DIC,DIQ,TIUPROB,TIUNARR,TIUNARR1,TIUNARR2,TIUPB
SET TIUI=0
+2 SET TIUL=TIUL+1
DO BLANK(TIUL)
SET TIUL=TIUL+1
+3 DO SET(TIUL,1,"Associated Problems ",$GET(IORVON),$GET(IORVOFF))
+4 IF '+$ORDER(^TIU(8925.9,"B",+TIUDA,0))
DO SET(TIUL,25,"No linked problems.")
+5 FOR
SET TIUI=$ORDER(^TIU(8925.9,"B",TIUDA,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 SET DA=TIUI
SET DR=".02;.05"
SET DIC="^TIU(8925.9,"
SET DIQ="TIUPROB"
+7 DO EN^DIQ1
if $DATA(TIUPROB)'>9
QUIT
+8 SET TIUL=TIUL+1
+9 SET TIUNARR=$GET(TIUPROB(8925.9,TIUI,.05))
+10 SET TIUNARR1=$PIECE(TIUNARR,"(")
SET TIUNARR2=$PIECE(TIUNARR,TIUNARR1,2)
+11 SET TIUNARR=$$MIXED^TIULS(TIUNARR1)_TIUNARR2
+12 SET TIUNARR=$EXTRACT(TIUNARR,1,54)
+13 DO SET(TIUL,5,TIUNARR)
+14 SET TIUPB=$GET(TIUPROB(8925.9,TIUI,.02))
+15 SET TIUPB="(ICD-9-CM "_TIUPB_")"
+16 DO SET(TIUL,61,TIUPB)
End DoDot:1
+17 QUIT
EDIT(TIUDA,TIUL) ; Edits
+1 NEW TIUI,DR,DA,DIC,DIQ,TIUED
SET TIUI=0
+2 SET TIUL=TIUL+1
DO BLANK(TIUL)
SET TIUL=TIUL+1
+3 DO SET(TIUL,1,"Edit Information ",$GET(IORVON),$GET(IORVOFF))
+4 IF '+$ORDER(^TIU(8925.5,"B",+TIUDA,0))
DO SET(TIUL,22,"No edits since entry.")
+5 FOR
SET TIUI=$ORDER(^TIU(8925.5,"B",TIUDA,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 SET DA=TIUI
SET DR=".02:03"
SET DIC="^TIU(8925.5,"
SET DIQ="TIUED"
+7 DO EN^DIQ1
if $DATA(TIUED)'>9!($GET(TIUED(8925.5,TIUI,.02))']"")
QUIT
+8 SET TIUL=TIUL+1
+9 DO SET(TIUL,2," Edit Date: "_$GET(TIUED(8925.5,TIUI,.02)))
+10 DO SET(TIUL,44," Edited By: "_$GET(TIUED(8925.5,TIUI,.03)))
End DoDot:1
+11 QUIT
SIGN(TIUREC,TIUL) ; Signature
+1 SET TIUL=TIUL+1
DO BLANK(TIUL)
SET TIUL=TIUL+1
+2 DO SET(TIUL,1,"Signature Information ",$GET(IORVON),$GET(IORVOFF))
+3 DO SET(TIUL+1,2," Signed Date: "_$GET(TIUREC(8925,TIUDA,1501)))
+4 DO SET(TIUL+3,2," Cosigned Date: "_$GET(TIUREC(8925,TIUDA,1507)))
+5 DO SET(TIUL+1,40," Signed By: "_$GET(TIUREC(8925,TIUDA,1502)))
+6 DO SET(TIUL+2,40," Signature Mode: "_$GET(TIUREC(8925,TIUDA,1505)))
+7 DO SET(TIUL+3,40," Cosigned By: "_$GET(TIUREC(8925,TIUDA,1508)))
+8 DO SET(TIUL+4,40," Cosignature Mode: "_$GET(TIUREC(8925,TIUDA,1511)))
+9 SET TIUL=TIUL+4
+10 QUIT
XTRASIGN(TIUDA,TIUL) ; Additional signers
+1 NEW TIUI,DA,DR,DIC,DIQ,TIUXTRA
+2 SET TIUI=0
+3 SET TIUL=TIUL+1
DO BLANK(TIUL)
SET TIUL=TIUL+1
+4 DO SET(TIUL,1,"Receipt Acknowledged By ",$GET(IORVON),$GET(IORVOFF))
+5 FOR
SET TIUI=$ORDER(^TIU(8925.7,"B",TIUDA,TIUI))
if +TIUI'>0
QUIT
Begin DoDot:1
+6 SET DA=TIUI
SET DR=".03:.08"
SET DIC="^TIU(8925.7,"
SET DIQ="TIUXTRA"
+7 DO EN^DIQ1
if $DATA(TIUXTRA)'>9
QUIT
+8 SET TIUL=TIUL+1
+9 DO SET(TIUL,2," Signed Date: "_$GET(TIUXTRA(8925.7,DA,.04)))
+10 DO SET(TIUL,40," Signed By: "_$GET(TIUXTRA(8925.7,DA,.06)))
+11 SET TIUL=TIUL+1
+12 DO SET(TIUL,2,"Expected Signer: "_$GET(TIUXTRA(8925.7,DA,.03)))
+13 DO SET(TIUL,40," Signature Mode: "_$GET(TIUXTRA(8925.7,DA,.08)))
End DoDot:1
+14 QUIT
PRIVACY(TIUREC,TIUL) ; Privacy Act
+1 SET TIUL=TIUL+1
DO BLANK(TIUL)
SET TIUL=TIUL+1
+2 DO SET(TIUL,1,"Privacy Act Information ",$GET(IORVON),$GET(IORVOFF))
+3 SET TIUL=TIUL+1
+4 DO SET(TIUL,2," Amended Date: "_$GET(TIUREC(8925,TIUDA,1601)))
+5 DO SET(TIUL,40," Amended By: "_$GET(TIUREC(8925,TIUDA,1602)))
+6 SET TIUL=TIUL+1
+7 DO SET(TIUL,2," Deleted Date: "_$GET(TIUREC(8925,TIUDA,1611)))
+8 DO SET(TIUL,40," Deleted By: "_$GET(TIUREC(8925,TIUDA,1610)))
+9 SET TIUL=TIUL+1
+10 DO SET(TIUL,2," Reason: "_$GET(TIUREC(8925,TIUDA,1612)))
+11 QUIT
BODY(TIUDA,TIUL) ; body of document
+1 NEW CANSEE
+2 SET TIUL=TIUL+1
DO BLANK(TIUL)
SET TIUL=TIUL+1
+3 DO SET(TIUL,1,"Document Body ",$GET(IORVON),$GET(IORVOFF))
+4 SET TIUL=TIUL+1
DO BLANK(TIUL)
+5 SET CANSEE=$$CANDO^TIULP(TIUDA,"VIEW")
+6 IF '+CANSEE
DO NOSEE(CANSEE,.TIUL)
QUIT
+7 IF '$DATA(TIUGDATA)
SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
+8 DO LOADREC^TIUBR1(TIUDA,.TIUL,TIUGDATA,$GET(TIUGWHOL))
+9 KILL ^TMP("TIU ADDENDUM",$JOB)
+10 QUIT
ISCOMP(DA) ; Evaluate whether a given record is a component
+1 NEW TIUY,TIUTYP
+2 SET TIUTYP=+$GET(^TIU(8925,DA,0))
+3 SET TIUY=$SELECT($PIECE($GET(^TIU(8925.1,+TIUTYP,0)),U,4)="CO":1,1:0)
+4 QUIT TIUY
NOSEE(CANSEE,TIUJ) ; When the user shouldn't see the data...
+1 SET TIUJ=+$GET(TIUJ)+1
+2 DO SET(TIUJ,2,$PIECE(CANSEE,U,2))
+3 QUIT
SET(TIULINE,TIUCOL,TIUTEXT,ON,OFF) ; set display info in array
+1 if '$DATA(@VALMAR@(TIULINE,0))
DO BLANK(.TIULINE)
+2 DO SET^VALM10(.TIULINE,$$SETSTR^VALM1(.TIUTEXT,@VALMAR@(TIULINE,0),.TIUCOL,$LENGTH(TIUTEXT)))
+3 if $GET(ON)]""!($GET(OFF)]"")
DO CNTRL^VALM10(.TIULINE,.TIUCOL,$LENGTH(TIUTEXT),$GET(ON),$GET(OFF))
+4 if '(TIULINE#5)&'+$GET(HUSH)
WRITE "."
+5 QUIT
+6 ;
BLANK(TIULINE) ; blank line
+1 DO SET^VALM10(.TIULINE,$JUSTIFY("",80))
+2 QUIT
