ORWTIU ;SLC/REV - Functions for GUI PARAMETER ACTIONS ;Feb 10, 2021@11:37:06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,195,243,377,539**;Dec 17, 1997;Build 41
;
; External Reference
; DBIA 6211 ^TIUCOP
; DBIA 7225 REQDFLD^TIUPREF
;
GTTIUCTX(Y,ORUSER) ; Returns current Notes view context for user
N OCCLIM,SHOWSUB
S Y=$$GET^XPAR("ALL","ORCH CONTEXT NOTES",1)
I +$P(Y,";",5)=0 D
. S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
. S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
S SHOWSUB=$P(Y,";",6)
S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
Q
SVTIUCTX(Y,ORCTXT) ; Save new Notes view preferences for user
N TMP
S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1)
I TMP'="" D Q
. D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
Q
GTDCCTX(Y,ORUSER) ; Returns current DC Summary view context for user
N OCCLIM,SHOWSUB
S Y=$$GET^XPAR("ALL","ORCH CONTEXT SUMMRIES",1)
I +$P(Y,";",5)=0 D
. S OCCLIM=$P($$PERSPRF^TIULE(DUZ),U,10)
. S:+OCCLIM>0 $P(Y,";",5)=OCCLIM
S SHOWSUB=$P(Y,";",6)
S $P(Y,";",6)=$S(SHOWSUB'="":SHOWSUB,1:0)
Q
SVDCCTX(Y,ORCTXT) ; Save new DC Summary view preferences for user
N TMP
S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1)
I TMP'="" D Q
. D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
Q
;
PRINTW(ORY,ORDA,ORFLG) ;TIU print to windows printer
N ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORERR,ORWIN,ORHANDLE
N IOM,IOSL,IOST,IOF,IOT,IOS
S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORWIN=1,ORHANDLE="ORWTIU"
S ORY=$NA(^TMP(ORSUB,$J,1))
S ORHFS=$$HFS^ORWRP()
D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
I POP D Q
. I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for TIU print")
D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
N $ETRAP,$ESTACK
S $ETRAP="D ERR^ORWRP Q"
U IO
D RPC^TIUPD(.ORERR,ORDA,ORIO,ORFLG,ORWIN)
D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
Q
GTLSTITM(ORY,ORTIUDA) ; Return single listbox item for document
Q:+$G(ORTIUDA)=0
S ORY=ORTIUDA_U_$$RESOLVE^TIUSRVLO(ORTIUDA)
Q
IDNOTES(ORY) ; Is ID Notes installed?
S ORY=$$PATCH^XPDUTL("TIU*1.0*100")
Q
CANLINK(ORY,ORTITLE) ;Can the title be an ID child?
; DBIA #2322
S ORY=$$CANLINK^TIULP(ORTITLE)
Q
GETCP(ORY,ORTIUDA) ; Checks required CP fields before signature
S ORY=""
N ORTITLE,ORAUTH,ORCOS,ORPSUMCD,ORPROCDT,ORROOT,ORERR,ORREFDT
S ORERR="",ORROOT=$NA(^TMP("ORTIU",$J))
D EXTRACT^TIULQ(ORTIUDA,.ORROOT,.ORERR,".01;1202;1208;70201;70202;1301",,,"I")
S ORTITLE=@ORROOT@(ORTIUDA,".01","I")
S ORAUTH=@ORROOT@(ORTIUDA,"1202","I")
S ORCOS=@ORROOT@(ORTIUDA,"1208","I")
S ORPSUMCD=@ORROOT@(ORTIUDA,"70201","I")
S ORPROCDT=@ORROOT@(ORTIUDA,"70202","I")
S ORREFDT=@ORROOT@(ORTIUDA,"1301","I")
S ORY=ORAUTH_U_ORCOS_U_ORPSUMCD_U_ORPROCDT_U_ORTITLE_U_ORREFDT
K @ORROOT
Q
CHKTXT(ORY,ORTIUDA) ; Checks for presence of text before signature
S ORY='$$EMPTYDOC^TIULF(ORTIUDA) ;DBIA #4426
Q
;
EXCCOPY(ORY,ORTIUDA) ; Checks if note is excluded from copy/paste tracking
I +$G(ORTIUDA)=0 S ORY="-1^TIU IEN required" Q
S ORY=$$EXC^TIUCOP(ORTIUDA)
Q
;
EXCPLST(ORY) ;Returns a list of notes excluded from copy/paste tracking
D EXCLST^TIUCOP(.ORY)
Q
;
PCTCOPY(ORY,DIV) ; Return the Copy/Paste verification percentage
I +$G(DIV)=0 S ORY="-1^Institution is required" Q
S ORY=$$PCT^TIUCOP(DIV)
Q
;
WRDCOPY(ORY,DIV) ; Return the Copy/Paste required number of words
I +$G(DIV)=0 S ORY="-1^Institution is required" Q
S ORY=$$WORDS^TIUCOP(DIV)
Q
;
GETCOPY(ORY,ORUSER,DIV,STRT) ; Returns tracked copied text for user
I $G(STRT)="" S STRT=""
I +$G(ORUSER)=0 S ORUSER=DUZ
I +$G(DIV)=0 S ORY="-1^Institution is required" Q
S ORY(0,0)=-1
D GETCOPY^TIUCOP(DIV,ORUSER,.ORY,STRT)
I +ORY(0,0)>0 D
. N CNT,ND,ND1,X
. S CNT=0
. S ND="" F S ND=$O(ORY(ND)) Q:ND="" D
.. S ND1="" F S ND1=$O(ORY(ND,ND1)) Q:ND1="" D
... S X="("_ND_","_ND1_")="
... S CNT=CNT+1
... S ORY(CNT)=X_$G(ORY(ND,ND1))
... K ORY(ND,ND1)
I +$G(ORY(0,0))=-1 S ORY(-1)=$P($G(ORY),U,2) K ORY(0,0)
Q
;
SVCOPY(Y,ORTXT,DIV) ; Saves tracked copied text for user
N CNT,LN,ORDATA,ORERR,ORPC,ORTMP,TXT,X
I +$G(DIV)=0 S Y="-1^Institution is required" Q
I '$D(ORTXT) S Y="-1^Copied text not received" Q
S ORERR=""
S Y=$$PUTCOPY^TIUCOP(DIV,.ORTXT,.ORERR)
I Y=0,$G(ORERR("ERR"))'="" S Y=$G(ORERR("ERR"))
I Y=0,$G(ORERR("ERR"))="" S Y="-1^Unidentified error during save."
Q
;
CHKPASTE(ORY,DIV,DOC) ; Return whether or not the user has copy buffer data
S ORY=$$CHKPASTE^TIUCOP(DIV,DOC)
Q
;
GETPASTE(ORY,ORTIU,DIV) ; Returns pasted text for current note
N FILE,IEN1,IENSV,X,Y1,Y,ARY,FLTMP,IEN
I +$G(DIV)=0 S ORY="-1^Institution is required" Q
I +$G(ORTIU)=0 S ORY="-1^Document ien is required." Q
S IEN1=1
S (ARY(0,0),ORY(0,0))=-1
I $L(ORTIU,";")=2,$P(ORTIU,";",2)'="" D
. S IEN1=0
. S FILE=$P(ORTIU,";",2),ORTIU=+ORTIU,X=""
. I FILE=123 D Q
.. F S X=$O(^GMR(123,ORTIU,50,"B",X)) Q:X="" D
... I $P(X,";",2)'="TIU(8925," Q
... N CHILD,PARNT
... I '$D(^TIU(8925,+X,0)) Q
... S PARNT=+$P(^TIU(8925,+X,0),U,6)
... I PARNT>0 D
.... S CHILD=""
.... F S CHILD=$O(^TIU(8925,"DAD",PARNT,CHILD)) Q:CHILD="" D
..... I $D(FLTMP(CHILD)) Q
..... S Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
..... I Y>0 D GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY) S FLTMP(CHILD)=1 D LOADORY(.ARY,.ORY)
.... I $D(FLTMP(PARNT)) Q
.... S Y=$$VIEW^TIUCOP(DUZ,PARNT,DIV)
.... I Y>0 D GETPASTE^TIUCOP(PARNT,DIV,"OR",.ARY) S FLTMP(PARNT)=1 D LOADORY(.ARY,.ORY)
... I PARNT=0 D
.... S CHILD=""
.... F S CHILD=$O(^TIU(8925,"DAD",+X,CHILD)) Q:CHILD="" D
..... I $D(FLTMP(CHILD)) Q
..... S Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
..... I Y>0 D GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY) S FLTMP(CHILD)=1 D LOADORY(.ARY,.ORY)
.... I $D(FLTMP(+X)) Q
.... S Y=$$VIEW^TIUCOP(DUZ,+X,DIV) I Y>0 D
..... D GETPASTE^TIUCOP(+X,DIV,"OR",.ARY) S FLTMP(+X)=1 D LOADORY(.ARY,.ORY)
. N CHILD,PARNT
. I '$D(^TIU(8925,+ORTIU,0)) Q
. S PARNT=+$P(^TIU(8925,+ORTIU,0),U,6)
. I PARNT>0 D
.. S CHILD=""
.. F S CHILD=$O(^TIU(8925,"DAD",PARNT,CHILD)) Q:CHILD="" D
... I $D(FLTMP(CHILD)) Q
... S Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
... I Y>0 D GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY) S FLTMP(CHILD)=1 D LOADORY(.ARY,.ORY)
.. I $D(FLTMP(PARNT)) Q
.. S Y=$$VIEW^TIUCOP(DUZ,PARNT,DIV)
.. I Y>0 D GETPASTE^TIUCOP(PARNT,DIV,"OR",.ARY) S FLTMP(PARNT)=1 D LOADORY(.ARY,.ORY)
. I PARNT=0 D
.. S CHILD=""
.. F S CHILD=$O(^TIU(8925,"DAD",+ORTIU,CHILD)) Q:CHILD="" D
... I $D(FLTMP(CHILD)) Q
... S Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
... I Y>0 D GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY) S FLTMP(CHILD)=1 D LOADORY(.ARY,.ORY)
.. I $D(FLTMP(+ORTIU)) Q
.. S Y=$$VIEW^TIUCOP(DUZ,+ORTIU,DIV) I Y>0 D
... D GETPASTE^TIUCOP(+ORTIU,DIV,"OR",.ARY) S FLTMP(+ORTIU)=1 D LOADORY(.ARY,.ORY)
I IEN1=1 D
. N CHILD,PARNT
. I '$D(^TIU(8925,+ORTIU,0)) Q
. S PARNT=+$P(^TIU(8925,+ORTIU,0),U,6)
. I PARNT>0 D
.. S CHILD=""
.. F S CHILD=$O(^TIU(8925,"DAD",PARNT,CHILD)) Q:CHILD="" D
... I $D(FLTMP(CHILD)) Q
... S Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
... I Y>0 D GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY) S FLTMP(CHILD)=1 D LOADORY(.ARY,.ORY)
.. I $D(FLTMP(PARNT)) Q
.. S Y=$$VIEW^TIUCOP(DUZ,PARNT,DIV)
.. I Y>0 D GETPASTE^TIUCOP(PARNT,DIV,"OR",.ARY) S FLTMP(PARNT)=1 D LOADORY(.ARY,.ORY)
. I PARNT=0 D
.. S CHILD=""
.. F S CHILD=$O(^TIU(8925,"DAD",+ORTIU,CHILD)) Q:CHILD="" D
... I $D(FLTMP(CHILD)) Q
... S Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
... I Y>0 D GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY) S FLTMP(CHILD)=1 D LOADORY(.ARY,.ORY)
.. I $D(FLTMP(+ORTIU)) Q
.. S Y=$$VIEW^TIUCOP(DUZ,+ORTIU,DIV) I Y>0 D
... D GETPASTE^TIUCOP(+ORTIU,DIV,"OR",.ARY) S FLTMP(+ORTIU)=1 D LOADORY(.ARY,.ORY)
I +ORY(0,0)=-1 S ORY(-1)=$P($G(ORY),U,2) S ORY("0,0")=-1 K ORY(0,0) Q
I +ORY(0,0)'<0 D
. N CNT,ND,ND1,ND2,X
. S CNT=0
. S ND="" F S ND=$O(ORY(ND)) Q:ND="" D
.. S ND1="" F S ND1=$O(ORY(ND,ND1)) Q:ND1="" D
... S X="("_ND_","_ND1_")="
... S CNT=CNT+1
... S ORY(CNT)=X_$G(ORY(ND,ND1))
... S ND2="" F S ND2=$O(ORY(ND,ND1,ND2)) Q:ND2="" D
.... S X="("_ND_","_ND1_","_ND2_")="
.... S CNT=CNT+1
.... S ORY(CNT)=X_$G(ORY(ND,ND1,ND2))
... K ORY(ND,ND1)
Q
;
LOADORY(ARY,ORY) ;Take an array and add it to a second array
N CNT,CNT2,CNT3,LNCNT
I +ARY(0,0)<0 Q
S LNCNT=+$O(ORY(""),-1)
S CNT=""
F S CNT=$O(ARY(CNT)) Q:CNT="" D
. I +CNT=0 S ORY(0,0)=$S(+$G(ORY(0,0))>0:+$G(ORY(0,0)),1:0)+$G(ARY(0,0)) K ARY(0,0) Q
. S LNCNT=LNCNT+1
. S CNT2=""
. F S CNT2=$O(ARY(CNT,CNT2)) Q:CNT2="" D
.. S ORY(LNCNT,CNT2)=$G(ARY(CNT,CNT2))
.. S CNT3=""
.. F S CNT3=$O(ARY(CNT,CNT2,CNT3)) Q:CNT3="" D
... S ORY(LNCNT,CNT2,CNT3)=$G(ARY(CNT,CNT2,CNT3))
.. K ARY(CNT,CNT2)
Q
;
FORMAT(ORY) ;Format result for CPRS GUI RPC
N X,Y
S X=""
F S X=$O(ORY(X)) Q:X="" D
. S Y=""
. F S Y=$O(ORY(X,Y)) Q:Y="" D
.. S ORY(X_","_Y)=$G(ORY(X,Y))
.. K ORY(X,Y)
Q
;
SVPASTE(ORY,ORTXT,DIV) ; Saves pasted text for the Copy/Paste functionality
N ORERR,Y
I +$G(DIV)=0 S ORY="-1^Institution is required" Q
I '$D(ORTXT) S ORY="-1^Pasted text not received" Q
S ORERR=""
S Y=0
S Y=$$PUTPASTE^TIUCOP(.ORY,DIV,.ORTXT,.ORERR)
I Y=0,$G(ORERR("ERR"))'="" S ORY=$G(ORERR("ERR"))
I Y=0,$G(ORERR("ERR"))="" S ORY="-1^Unidentified error during save."
Q
;
VIEWCOPY(Y,USER,IEN,INST) ; Is user allowed to view copy/paste information
N FILE,IENSV,X,Y1
S (Y,Y1)=0
S IEN=$G(IEN)
I +$G(USER)'>0 S USER=DUZ
I +$G(INST)=0 S INST=0
I $L(IEN,";")=2 D Q
. S FILE=$P(IEN,";",2),IENSV=+IEN,(IEN,X)=""
. I FILE=123 D Q
.. F S X=$O(^GMR(123,IENSV,50,"B",X)) Q:X="" D Q:Y=2
... I $P(X,";",2)'="TIU(8925," Q
... S Y=$$VIEW1(+X,INST,USER,Y1)
... I Y=2
.. I Y1>Y S Y=Y1
. S Y=$$VIEW1(+IENSV,INST,USER,Y1)
. I Y1>Y S Y=Y1
I +IEN=0 S Y=$$VIEW^TIUCOP(USER,0,INST) Q
S Y=$$VIEW1(+IEN,INST,USER,Y1)
I Y1>Y S Y=Y1
Q
;
VIEW1(IEN,INST,USER,Y1) ;Find parent and child notes and call $$VIEW^TIUCOP for each
N CHILD,PARNT,USAGE
S USAGE=0
I '$D(^TIU(8925,+IEN,0)) Q USAGE
S PARNT=+$P(^TIU(8925,+IEN,0),U,6)
I PARNT>0 D
. S CHILD=""
. F S CHILD=$O(^TIU(8925,"DAD",PARNT,CHILD)) Q:CHILD="" D Q:USAGE=2
.. S USAGE=$$VIEW^TIUCOP(USER,CHILD,INST)
.. I USAGE=2 Q
.. I USAGE=1 S Y1=USAGE
. S USAGE=$$VIEW^TIUCOP(USER,PARNT,INST)
. I USAGE=1 S Y1=USAGE
I PARNT=0 D
. S CHILD=""
. F S CHILD=$O(^TIU(8925,"DAD",+IEN,CHILD)) Q:CHILD="" D Q:USAGE=2
.. S USAGE=$$VIEW^TIUCOP(USER,CHILD,INST)
.. I USAGE=2 Q
.. I USAGE=1 S Y1=USAGE
. I USAGE=2 Q
. S USAGE=$$VIEW^TIUCOP(USER,+IEN,INST)
. I Y1>USAGE S USAGE=Y1
Q USAGE
;
LDCPIDNT(VAL) ;Return the copy/paste identifier parameters
N X
S VAL=""
S VAL=$$GET^XPAR("PKG","ORQQTIU COPY/PASTE IDENT",,"Q")
I VAL="-2;CP Disable Override" S VAL=-2 Q
S VAL=$$GET^XPAR("ALL","ORQQTIU COPY/PASTE IDENT",,"Q")
I VAL["-2" S VAL=-2 Q
I VAL="" S VAL="-1;Visual Disable Override" ;"0,0,1,1,65535" ;Default to Highlight and Underline
Q
;
SVCPIDNT(ORERR,VAL) ;Save the copy/paste identifier parameters
; VAL=Bold,Italicize,Underline,Highlight,Highlight Color
N PARAM
S ORERR=0
I $G(VAL)="" S ORERR="-1^Input parameter is missing" Q
D EN^XPAR("USR","ORQQTIU COPY/PASTE IDENT",1,VAL,.ORERR)
Q
;
VALCODE(X) ;Validation code for the ORQQTIU COPY/PASTE IDENT parameter
; Returns 1 if fail
;ENT is expected to exist when this is called
;N RTN
;S RTN=0
I X="" Q 1
;The following line is an attribute which can be used to disable
;copy/paste identifiers. This only affects the visual components of
;copy/paste. All tracking continues to occur.
I X="-1;Visual Disable Override" Q 0
;The following line is a hidden attribute which can be used to disable
;copy/paste functionality. NOTE: This functionality is only for use at
;the direction of the VACO Health Information Management Program
;Office or the event of an Emergency situation.
;I X="-2;CP Disable Override",$P(ENT,";",2)="DIC(9.4," Q 0
I X="-2;CP Disable Override" Q 0
;
I (X'?4(1N1",")1(1"-"1.N1",",1.N1",")5(1N1",")1(1"-"1.N1","1.N,1.N1","1.N))!(($P(X,U,4)=1)&($P(X,U,5)'>0))!(($P(X,U,10)=1)&($P(X,U,11)'>0)) Q 1
I (($P(X,",",1)'=1)&($P(X,",",1)'=0))!(($P(X,",",2)'=1)&($P(X,",",2)'=0))!(($P(X,",",3)'=1)&($P(X,",",3)'=0))!(($P(X,",",4)'=1)&($P(X,",",4)'=0)) Q 1
I ((($P(X,",",6)'=1)&($P(X,",",6)'=0))!(($P(X,",",7)'=1)&($P(X,",",7)'=0))!(($P(X,",",8)'=1)&($P(X,",",8)'=0))!(($P(X,",",9)'=1)&($P(X,",",9)'=0))!(($P(X,",",10)'=1)&($P(X,",",10)'=0))) Q 1
Q 0
;
START(VAL,DFN,DIV,IP,HWND) ;Start copy retrieval background job
I +$G(DFN)<1 S DFN=DUZ
I $G(IP)="" Q
I $G(HWND)="" Q
I +$G(DIV)<1 Q
D START^TIUCOP(.VAL,DFN,IP,HWND,DIV)
Q
;
POLL(LST,DFN,IP,HWND) ;Poll copy retrieval background job and return results
I +$G(DFN)<1 S DFN=DUZ
I $G(IP)="" Q
I $G(HWND)="" Q
D POLL^TIUCOP(.LST,DFN,IP,HWND)
I $G(LST(1))="" S LST(1)=-1
Q
;
STOP(OK,DFN,IP,HWND) ;Stop copy retrieval background job
S OK=0
I +$G(DFN)<1 S DFN=DUZ
I $G(IP)="" Q
I $G(HWND)="" Q
D STOP^TIUCOP(.OK,DFN,IP,HWND)
Q
;
CLEAN ;clean up ^XTMP nodes related to copy/paste
;The task number is returned. Currently, we do nothing with it.
N TASK
S TASK=0
D CLEAN^TIUCOP(.TASK)
Q
;
REQDFLD(VAL,ACTION,INPUT) ;Load or Save Template Required Fields Preferences
D REQDFLD^TIUPREF(.VAL,$G(ACTION),$G(INPUT))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWTIU 13558 printed Dec 13, 2024@02:37:30 Page 2
ORWTIU ;SLC/REV - Functions for GUI PARAMETER ACTIONS ;Feb 10, 2021@11:37:06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,195,243,377,539**;Dec 17, 1997;Build 41
+2 ;
+3 ; External Reference
+4 ; DBIA 6211 ^TIUCOP
+5 ; DBIA 7225 REQDFLD^TIUPREF
+6 ;
GTTIUCTX(Y,ORUSER) ; Returns current Notes view context for user
+1 NEW OCCLIM,SHOWSUB
+2 SET Y=$$GET^XPAR("ALL","ORCH CONTEXT NOTES",1)
+3 IF +$PIECE(Y,";",5)=0
Begin DoDot:1
+4 SET OCCLIM=$PIECE($$PERSPRF^TIULE(DUZ),U,10)
+5 if +OCCLIM>0
SET $PIECE(Y,";",5)=OCCLIM
End DoDot:1
+6 SET SHOWSUB=$PIECE(Y,";",6)
+7 SET $PIECE(Y,";",6)=$SELECT(SHOWSUB'="":SHOWSUB,1:0)
+8 QUIT
SVTIUCTX(Y,ORCTXT) ; Save new Notes view preferences for user
+1 NEW TMP
+2 SET TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1)
+3 IF TMP'=""
Begin DoDot:1
+4 DO CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
End DoDot:1
QUIT
+5 DO ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT NOTES",1,ORCTXT)
+6 QUIT
GTDCCTX(Y,ORUSER) ; Returns current DC Summary view context for user
+1 NEW OCCLIM,SHOWSUB
+2 SET Y=$$GET^XPAR("ALL","ORCH CONTEXT SUMMRIES",1)
+3 IF +$PIECE(Y,";",5)=0
Begin DoDot:1
+4 SET OCCLIM=$PIECE($$PERSPRF^TIULE(DUZ),U,10)
+5 if +OCCLIM>0
SET $PIECE(Y,";",5)=OCCLIM
End DoDot:1
+6 SET SHOWSUB=$PIECE(Y,";",6)
+7 SET $PIECE(Y,";",6)=$SELECT(SHOWSUB'="":SHOWSUB,1:0)
+8 QUIT
SVDCCTX(Y,ORCTXT) ; Save new DC Summary view preferences for user
+1 NEW TMP
+2 SET TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1)
+3 IF TMP'=""
Begin DoDot:1
+4 DO CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
End DoDot:1
QUIT
+5 DO ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT SUMMRIES",1,ORCTXT)
+6 QUIT
+7 ;
PRINTW(ORY,ORDA,ORFLG) ;TIU print to windows printer
+1 NEW ZTQUEUED,ORHFS,ORSUB,ORIO,ORSTATUS,ROOT,ORERR,ORWIN,ORHANDLE
+2 NEW IOM,IOSL,IOST,IOF,IOT,IOS
+3 SET (ORSUB,ROOT)="ORDATA"
SET ORIO="OR WINDOWS HFS"
SET ORWIN=1
SET ORHANDLE="ORWTIU"
+4 SET ORY=$NAME(^TMP(ORSUB,$JOB,1))
+5 SET ORHFS=$$HFS^ORWRP()
+6 DO HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
+7 IF POP
Begin DoDot:1
+8 IF $DATA(ROOT)
DO SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file for TIU print")
End DoDot:1
QUIT
+9 DO IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
+10 NEW $ETRAP,$ESTACK
+11 SET $ETRAP="D ERR^ORWRP Q"
+12 USE IO
+13 DO RPC^TIUPD(.ORERR,ORDA,ORIO,ORFLG,ORWIN)
+14 DO HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
+15 QUIT
GTLSTITM(ORY,ORTIUDA) ; Return single listbox item for document
+1 if +$GET(ORTIUDA)=0
QUIT
+2 SET ORY=ORTIUDA_U_$$RESOLVE^TIUSRVLO(ORTIUDA)
+3 QUIT
IDNOTES(ORY) ; Is ID Notes installed?
+1 SET ORY=$$PATCH^XPDUTL("TIU*1.0*100")
+2 QUIT
CANLINK(ORY,ORTITLE) ;Can the title be an ID child?
+1 ; DBIA #2322
+2 SET ORY=$$CANLINK^TIULP(ORTITLE)
+3 QUIT
GETCP(ORY,ORTIUDA) ; Checks required CP fields before signature
+1 SET ORY=""
+2 NEW ORTITLE,ORAUTH,ORCOS,ORPSUMCD,ORPROCDT,ORROOT,ORERR,ORREFDT
+3 SET ORERR=""
SET ORROOT=$NAME(^TMP("ORTIU",$JOB))
+4 DO EXTRACT^TIULQ(ORTIUDA,.ORROOT,.ORERR,".01;1202;1208;70201;70202;1301",,,"I")
+5 SET ORTITLE=@ORROOT@(ORTIUDA,".01","I")
+6 SET ORAUTH=@ORROOT@(ORTIUDA,"1202","I")
+7 SET ORCOS=@ORROOT@(ORTIUDA,"1208","I")
+8 SET ORPSUMCD=@ORROOT@(ORTIUDA,"70201","I")
+9 SET ORPROCDT=@ORROOT@(ORTIUDA,"70202","I")
+10 SET ORREFDT=@ORROOT@(ORTIUDA,"1301","I")
+11 SET ORY=ORAUTH_U_ORCOS_U_ORPSUMCD_U_ORPROCDT_U_ORTITLE_U_ORREFDT
+12 KILL @ORROOT
+13 QUIT
CHKTXT(ORY,ORTIUDA) ; Checks for presence of text before signature
+1 ;DBIA #4426
SET ORY='$$EMPTYDOC^TIULF(ORTIUDA)
+2 QUIT
+3 ;
EXCCOPY(ORY,ORTIUDA) ; Checks if note is excluded from copy/paste tracking
+1 IF +$GET(ORTIUDA)=0
SET ORY="-1^TIU IEN required"
QUIT
+2 SET ORY=$$EXC^TIUCOP(ORTIUDA)
+3 QUIT
+4 ;
EXCPLST(ORY) ;Returns a list of notes excluded from copy/paste tracking
+1 DO EXCLST^TIUCOP(.ORY)
+2 QUIT
+3 ;
PCTCOPY(ORY,DIV) ; Return the Copy/Paste verification percentage
+1 IF +$GET(DIV)=0
SET ORY="-1^Institution is required"
QUIT
+2 SET ORY=$$PCT^TIUCOP(DIV)
+3 QUIT
+4 ;
WRDCOPY(ORY,DIV) ; Return the Copy/Paste required number of words
+1 IF +$GET(DIV)=0
SET ORY="-1^Institution is required"
QUIT
+2 SET ORY=$$WORDS^TIUCOP(DIV)
+3 QUIT
+4 ;
GETCOPY(ORY,ORUSER,DIV,STRT) ; Returns tracked copied text for user
+1 IF $GET(STRT)=""
SET STRT=""
+2 IF +$GET(ORUSER)=0
SET ORUSER=DUZ
+3 IF +$GET(DIV)=0
SET ORY="-1^Institution is required"
QUIT
+4 SET ORY(0,0)=-1
+5 DO GETCOPY^TIUCOP(DIV,ORUSER,.ORY,STRT)
+6 IF +ORY(0,0)>0
Begin DoDot:1
+7 NEW CNT,ND,ND1,X
+8 SET CNT=0
+9 SET ND=""
FOR
SET ND=$ORDER(ORY(ND))
if ND=""
QUIT
Begin DoDot:2
+10 SET ND1=""
FOR
SET ND1=$ORDER(ORY(ND,ND1))
if ND1=""
QUIT
Begin DoDot:3
+11 SET X="("_ND_","_ND1_")="
+12 SET CNT=CNT+1
+13 SET ORY(CNT)=X_$GET(ORY(ND,ND1))
+14 KILL ORY(ND,ND1)
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF +$GET(ORY(0,0))=-1
SET ORY(-1)=$PIECE($GET(ORY),U,2)
KILL ORY(0,0)
+16 QUIT
+17 ;
SVCOPY(Y,ORTXT,DIV) ; Saves tracked copied text for user
+1 NEW CNT,LN,ORDATA,ORERR,ORPC,ORTMP,TXT,X
+2 IF +$GET(DIV)=0
SET Y="-1^Institution is required"
QUIT
+3 IF '$DATA(ORTXT)
SET Y="-1^Copied text not received"
QUIT
+4 SET ORERR=""
+5 SET Y=$$PUTCOPY^TIUCOP(DIV,.ORTXT,.ORERR)
+6 IF Y=0
IF $GET(ORERR("ERR"))'=""
SET Y=$GET(ORERR("ERR"))
+7 IF Y=0
IF $GET(ORERR("ERR"))=""
SET Y="-1^Unidentified error during save."
+8 QUIT
+9 ;
CHKPASTE(ORY,DIV,DOC) ; Return whether or not the user has copy buffer data
+1 SET ORY=$$CHKPASTE^TIUCOP(DIV,DOC)
+2 QUIT
+3 ;
GETPASTE(ORY,ORTIU,DIV) ; Returns pasted text for current note
+1 NEW FILE,IEN1,IENSV,X,Y1,Y,ARY,FLTMP,IEN
+2 IF +$GET(DIV)=0
SET ORY="-1^Institution is required"
QUIT
+3 IF +$GET(ORTIU)=0
SET ORY="-1^Document ien is required."
QUIT
+4 SET IEN1=1
+5 SET (ARY(0,0),ORY(0,0))=-1
+6 IF $LENGTH(ORTIU,";")=2
IF $PIECE(ORTIU,";",2)'=""
Begin DoDot:1
+7 SET IEN1=0
+8 SET FILE=$PIECE(ORTIU,";",2)
SET ORTIU=+ORTIU
SET X=""
+9 IF FILE=123
Begin DoDot:2
+10 FOR
SET X=$ORDER(^GMR(123,ORTIU,50,"B",X))
if X=""
QUIT
Begin DoDot:3
+11 IF $PIECE(X,";",2)'="TIU(8925,"
QUIT
+12 NEW CHILD,PARNT
+13 IF '$DATA(^TIU(8925,+X,0))
QUIT
+14 SET PARNT=+$PIECE(^TIU(8925,+X,0),U,6)
+15 IF PARNT>0
Begin DoDot:4
+16 SET CHILD=""
+17 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",PARNT,CHILD))
if CHILD=""
QUIT
Begin DoDot:5
+18 IF $DATA(FLTMP(CHILD))
QUIT
+19 SET Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
+20 IF Y>0
DO GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY)
SET FLTMP(CHILD)=1
DO LOADORY(.ARY,.ORY)
End DoDot:5
+21 IF $DATA(FLTMP(PARNT))
QUIT
+22 SET Y=$$VIEW^TIUCOP(DUZ,PARNT,DIV)
+23 IF Y>0
DO GETPASTE^TIUCOP(PARNT,DIV,"OR",.ARY)
SET FLTMP(PARNT)=1
DO LOADORY(.ARY,.ORY)
End DoDot:4
+24 IF PARNT=0
Begin DoDot:4
+25 SET CHILD=""
+26 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",+X,CHILD))
if CHILD=""
QUIT
Begin DoDot:5
+27 IF $DATA(FLTMP(CHILD))
QUIT
+28 SET Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
+29 IF Y>0
DO GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY)
SET FLTMP(CHILD)=1
DO LOADORY(.ARY,.ORY)
End DoDot:5
+30 IF $DATA(FLTMP(+X))
QUIT
+31 SET Y=$$VIEW^TIUCOP(DUZ,+X,DIV)
IF Y>0
Begin DoDot:5
+32 DO GETPASTE^TIUCOP(+X,DIV,"OR",.ARY)
SET FLTMP(+X)=1
DO LOADORY(.ARY,.ORY)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+33 NEW CHILD,PARNT
+34 IF '$DATA(^TIU(8925,+ORTIU,0))
QUIT
+35 SET PARNT=+$PIECE(^TIU(8925,+ORTIU,0),U,6)
+36 IF PARNT>0
Begin DoDot:2
+37 SET CHILD=""
+38 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",PARNT,CHILD))
if CHILD=""
QUIT
Begin DoDot:3
+39 IF $DATA(FLTMP(CHILD))
QUIT
+40 SET Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
+41 IF Y>0
DO GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY)
SET FLTMP(CHILD)=1
DO LOADORY(.ARY,.ORY)
End DoDot:3
+42 IF $DATA(FLTMP(PARNT))
QUIT
+43 SET Y=$$VIEW^TIUCOP(DUZ,PARNT,DIV)
+44 IF Y>0
DO GETPASTE^TIUCOP(PARNT,DIV,"OR",.ARY)
SET FLTMP(PARNT)=1
DO LOADORY(.ARY,.ORY)
End DoDot:2
+45 IF PARNT=0
Begin DoDot:2
+46 SET CHILD=""
+47 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",+ORTIU,CHILD))
if CHILD=""
QUIT
Begin DoDot:3
+48 IF $DATA(FLTMP(CHILD))
QUIT
+49 SET Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
+50 IF Y>0
DO GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY)
SET FLTMP(CHILD)=1
DO LOADORY(.ARY,.ORY)
End DoDot:3
+51 IF $DATA(FLTMP(+ORTIU))
QUIT
+52 SET Y=$$VIEW^TIUCOP(DUZ,+ORTIU,DIV)
IF Y>0
Begin DoDot:3
+53 DO GETPASTE^TIUCOP(+ORTIU,DIV,"OR",.ARY)
SET FLTMP(+ORTIU)=1
DO LOADORY(.ARY,.ORY)
End DoDot:3
End DoDot:2
End DoDot:1
+54 IF IEN1=1
Begin DoDot:1
+55 NEW CHILD,PARNT
+56 IF '$DATA(^TIU(8925,+ORTIU,0))
QUIT
+57 SET PARNT=+$PIECE(^TIU(8925,+ORTIU,0),U,6)
+58 IF PARNT>0
Begin DoDot:2
+59 SET CHILD=""
+60 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",PARNT,CHILD))
if CHILD=""
QUIT
Begin DoDot:3
+61 IF $DATA(FLTMP(CHILD))
QUIT
+62 SET Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
+63 IF Y>0
DO GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY)
SET FLTMP(CHILD)=1
DO LOADORY(.ARY,.ORY)
End DoDot:3
+64 IF $DATA(FLTMP(PARNT))
QUIT
+65 SET Y=$$VIEW^TIUCOP(DUZ,PARNT,DIV)
+66 IF Y>0
DO GETPASTE^TIUCOP(PARNT,DIV,"OR",.ARY)
SET FLTMP(PARNT)=1
DO LOADORY(.ARY,.ORY)
End DoDot:2
+67 IF PARNT=0
Begin DoDot:2
+68 SET CHILD=""
+69 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",+ORTIU,CHILD))
if CHILD=""
QUIT
Begin DoDot:3
+70 IF $DATA(FLTMP(CHILD))
QUIT
+71 SET Y=$$VIEW^TIUCOP(DUZ,CHILD,DIV)
+72 IF Y>0
DO GETPASTE^TIUCOP(CHILD,DIV,"OR",.ARY)
SET FLTMP(CHILD)=1
DO LOADORY(.ARY,.ORY)
End DoDot:3
+73 IF $DATA(FLTMP(+ORTIU))
QUIT
+74 SET Y=$$VIEW^TIUCOP(DUZ,+ORTIU,DIV)
IF Y>0
Begin DoDot:3
+75 DO GETPASTE^TIUCOP(+ORTIU,DIV,"OR",.ARY)
SET FLTMP(+ORTIU)=1
DO LOADORY(.ARY,.ORY)
End DoDot:3
End DoDot:2
End DoDot:1
+76 IF +ORY(0,0)=-1
SET ORY(-1)=$PIECE($GET(ORY),U,2)
SET ORY("0,0")=-1
KILL ORY(0,0)
QUIT
+77 IF +ORY(0,0)'<0
Begin DoDot:1
+78 NEW CNT,ND,ND1,ND2,X
+79 SET CNT=0
+80 SET ND=""
FOR
SET ND=$ORDER(ORY(ND))
if ND=""
QUIT
Begin DoDot:2
+81 SET ND1=""
FOR
SET ND1=$ORDER(ORY(ND,ND1))
if ND1=""
QUIT
Begin DoDot:3
+82 SET X="("_ND_","_ND1_")="
+83 SET CNT=CNT+1
+84 SET ORY(CNT)=X_$GET(ORY(ND,ND1))
+85 SET ND2=""
FOR
SET ND2=$ORDER(ORY(ND,ND1,ND2))
if ND2=""
QUIT
Begin DoDot:4
+86 SET X="("_ND_","_ND1_","_ND2_")="
+87 SET CNT=CNT+1
+88 SET ORY(CNT)=X_$GET(ORY(ND,ND1,ND2))
End DoDot:4
+89 KILL ORY(ND,ND1)
End DoDot:3
End DoDot:2
End DoDot:1
+90 QUIT
+91 ;
LOADORY(ARY,ORY) ;Take an array and add it to a second array
+1 NEW CNT,CNT2,CNT3,LNCNT
+2 IF +ARY(0,0)<0
QUIT
+3 SET LNCNT=+$ORDER(ORY(""),-1)
+4 SET CNT=""
+5 FOR
SET CNT=$ORDER(ARY(CNT))
if CNT=""
QUIT
Begin DoDot:1
+6 IF +CNT=0
SET ORY(0,0)=$SELECT(+$GET(ORY(0,0))>0:+$GET(ORY(0,0)),1:0)+$GET(ARY(0,0))
KILL ARY(0,0)
QUIT
+7 SET LNCNT=LNCNT+1
+8 SET CNT2=""
+9 FOR
SET CNT2=$ORDER(ARY(CNT,CNT2))
if CNT2=""
QUIT
Begin DoDot:2
+10 SET ORY(LNCNT,CNT2)=$GET(ARY(CNT,CNT2))
+11 SET CNT3=""
+12 FOR
SET CNT3=$ORDER(ARY(CNT,CNT2,CNT3))
if CNT3=""
QUIT
Begin DoDot:3
+13 SET ORY(LNCNT,CNT2,CNT3)=$GET(ARY(CNT,CNT2,CNT3))
End DoDot:3
+14 KILL ARY(CNT,CNT2)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
FORMAT(ORY) ;Format result for CPRS GUI RPC
+1 NEW X,Y
+2 SET X=""
+3 FOR
SET X=$ORDER(ORY(X))
if X=""
QUIT
Begin DoDot:1
+4 SET Y=""
+5 FOR
SET Y=$ORDER(ORY(X,Y))
if Y=""
QUIT
Begin DoDot:2
+6 SET ORY(X_","_Y)=$GET(ORY(X,Y))
+7 KILL ORY(X,Y)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SVPASTE(ORY,ORTXT,DIV) ; Saves pasted text for the Copy/Paste functionality
+1 NEW ORERR,Y
+2 IF +$GET(DIV)=0
SET ORY="-1^Institution is required"
QUIT
+3 IF '$DATA(ORTXT)
SET ORY="-1^Pasted text not received"
QUIT
+4 SET ORERR=""
+5 SET Y=0
+6 SET Y=$$PUTPASTE^TIUCOP(.ORY,DIV,.ORTXT,.ORERR)
+7 IF Y=0
IF $GET(ORERR("ERR"))'=""
SET ORY=$GET(ORERR("ERR"))
+8 IF Y=0
IF $GET(ORERR("ERR"))=""
SET ORY="-1^Unidentified error during save."
+9 QUIT
+10 ;
VIEWCOPY(Y,USER,IEN,INST) ; Is user allowed to view copy/paste information
+1 NEW FILE,IENSV,X,Y1
+2 SET (Y,Y1)=0
+3 SET IEN=$GET(IEN)
+4 IF +$GET(USER)'>0
SET USER=DUZ
+5 IF +$GET(INST)=0
SET INST=0
+6 IF $LENGTH(IEN,";")=2
Begin DoDot:1
+7 SET FILE=$PIECE(IEN,";",2)
SET IENSV=+IEN
SET (IEN,X)=""
+8 IF FILE=123
Begin DoDot:2
+9 FOR
SET X=$ORDER(^GMR(123,IENSV,50,"B",X))
if X=""
QUIT
Begin DoDot:3
+10 IF $PIECE(X,";",2)'="TIU(8925,"
QUIT
+11 SET Y=$$VIEW1(+X,INST,USER,Y1)
+12 IF Y=2
End DoDot:3
if Y=2
QUIT
+13 IF Y1>Y
SET Y=Y1
End DoDot:2
QUIT
+14 SET Y=$$VIEW1(+IENSV,INST,USER,Y1)
+15 IF Y1>Y
SET Y=Y1
End DoDot:1
QUIT
+16 IF +IEN=0
SET Y=$$VIEW^TIUCOP(USER,0,INST)
QUIT
+17 SET Y=$$VIEW1(+IEN,INST,USER,Y1)
+18 IF Y1>Y
SET Y=Y1
+19 QUIT
+20 ;
VIEW1(IEN,INST,USER,Y1) ;Find parent and child notes and call $$VIEW^TIUCOP for each
+1 NEW CHILD,PARNT,USAGE
+2 SET USAGE=0
+3 IF '$DATA(^TIU(8925,+IEN,0))
QUIT USAGE
+4 SET PARNT=+$PIECE(^TIU(8925,+IEN,0),U,6)
+5 IF PARNT>0
Begin DoDot:1
+6 SET CHILD=""
+7 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",PARNT,CHILD))
if CHILD=""
QUIT
Begin DoDot:2
+8 SET USAGE=$$VIEW^TIUCOP(USER,CHILD,INST)
+9 IF USAGE=2
QUIT
+10 IF USAGE=1
SET Y1=USAGE
End DoDot:2
if USAGE=2
QUIT
+11 SET USAGE=$$VIEW^TIUCOP(USER,PARNT,INST)
+12 IF USAGE=1
SET Y1=USAGE
End DoDot:1
+13 IF PARNT=0
Begin DoDot:1
+14 SET CHILD=""
+15 FOR
SET CHILD=$ORDER(^TIU(8925,"DAD",+IEN,CHILD))
if CHILD=""
QUIT
Begin DoDot:2
+16 SET USAGE=$$VIEW^TIUCOP(USER,CHILD,INST)
+17 IF USAGE=2
QUIT
+18 IF USAGE=1
SET Y1=USAGE
End DoDot:2
if USAGE=2
QUIT
+19 IF USAGE=2
QUIT
+20 SET USAGE=$$VIEW^TIUCOP(USER,+IEN,INST)
+21 IF Y1>USAGE
SET USAGE=Y1
End DoDot:1
+22 QUIT USAGE
+23 ;
LDCPIDNT(VAL) ;Return the copy/paste identifier parameters
+1 NEW X
+2 SET VAL=""
+3 SET VAL=$$GET^XPAR("PKG","ORQQTIU COPY/PASTE IDENT",,"Q")
+4 IF VAL="-2;CP Disable Override"
SET VAL=-2
QUIT
+5 SET VAL=$$GET^XPAR("ALL","ORQQTIU COPY/PASTE IDENT",,"Q")
+6 IF VAL["-2"
SET VAL=-2
QUIT
+7 ;"0,0,1,1,65535" ;Default to Highlight and Underline
IF VAL=""
SET VAL="-1;Visual Disable Override"
+8 QUIT
+9 ;
SVCPIDNT(ORERR,VAL) ;Save the copy/paste identifier parameters
+1 ; VAL=Bold,Italicize,Underline,Highlight,Highlight Color
+2 NEW PARAM
+3 SET ORERR=0
+4 IF $GET(VAL)=""
SET ORERR="-1^Input parameter is missing"
QUIT
+5 DO EN^XPAR("USR","ORQQTIU COPY/PASTE IDENT",1,VAL,.ORERR)
+6 QUIT
+7 ;
VALCODE(X) ;Validation code for the ORQQTIU COPY/PASTE IDENT parameter
+1 ; Returns 1 if fail
+2 ;ENT is expected to exist when this is called
+3 ;N RTN
+4 ;S RTN=0
+5 IF X=""
QUIT 1
+6 ;The following line is an attribute which can be used to disable
+7 ;copy/paste identifiers. This only affects the visual components of
+8 ;copy/paste. All tracking continues to occur.
+9 IF X="-1;Visual Disable Override"
QUIT 0
+10 ;The following line is a hidden attribute which can be used to disable
+11 ;copy/paste functionality. NOTE: This functionality is only for use at
+12 ;the direction of the VACO Health Information Management Program
+13 ;Office or the event of an Emergency situation.
+14 ;I X="-2;CP Disable Override",$P(ENT,";",2)="DIC(9.4," Q 0
+15 IF X="-2;CP Disable Override"
QUIT 0
+16 ;
+17 IF (X'?4(1N1",")1(1"-"1.N1",",1.N1",")5(1N1",")1(1"-"1.N1","1.N,1.N1","1.N))!(($PIECE(X,U,4)=1)&($PIECE(X,U,5)'>0))!(($PIECE(X,U,10)=1)&($PIECE(X,U,11)'>0))
QUIT 1
+18 IF (($PIECE(X,",",1)'=1)&($PIECE(X,",",1)'=0))!(($PIECE(X,",",2)'=1)&($PIECE(X,",",2)'=0))!(($PIECE(X,",",3)'=1)&($PIECE(X,",",3)'=0))!(($PIECE(X,",",4)'=1)&($PIECE(X,",",4)'=0))
QUIT 1
+19 IF ((($PIECE(X,",",6)'=1)&($PIECE(X,",",6)'=0))!(($PIECE(X,",",7)'=1)&($PIECE(X,",",7)'=0))!(($PIECE(X,",",8)'=1)&($PIECE(X,",",8)'=0))!(($PIECE(X,",",9)'=1)&($PIECE(X,",",9)'=0))!(($PIECE(X,",",10)'=1)&($PIECE(X,",",10)'=0)))
QUIT 1
+20 QUIT 0
+21 ;
START(VAL,DFN,DIV,IP,HWND) ;Start copy retrieval background job
+1 IF +$GET(DFN)<1
SET DFN=DUZ
+2 IF $GET(IP)=""
QUIT
+3 IF $GET(HWND)=""
QUIT
+4 IF +$GET(DIV)<1
QUIT
+5 DO START^TIUCOP(.VAL,DFN,IP,HWND,DIV)
+6 QUIT
+7 ;
POLL(LST,DFN,IP,HWND) ;Poll copy retrieval background job and return results
+1 IF +$GET(DFN)<1
SET DFN=DUZ
+2 IF $GET(IP)=""
QUIT
+3 IF $GET(HWND)=""
QUIT
+4 DO POLL^TIUCOP(.LST,DFN,IP,HWND)
+5 IF $GET(LST(1))=""
SET LST(1)=-1
+6 QUIT
+7 ;
STOP(OK,DFN,IP,HWND) ;Stop copy retrieval background job
+1 SET OK=0
+2 IF +$GET(DFN)<1
SET DFN=DUZ
+3 IF $GET(IP)=""
QUIT
+4 IF $GET(HWND)=""
QUIT
+5 DO STOP^TIUCOP(.OK,DFN,IP,HWND)
+6 QUIT
+7 ;
CLEAN ;clean up ^XTMP nodes related to copy/paste
+1 ;The task number is returned. Currently, we do nothing with it.
+2 NEW TASK
+3 SET TASK=0
+4 DO CLEAN^TIUCOP(.TASK)
+5 QUIT
+6 ;
REQDFLD(VAL,ACTION,INPUT) ;Load or Save Template Required Fields Preferences
+1 DO REQDFLD^TIUPREF(.VAL,$GET(ACTION),$GET(INPUT))
+2 QUIT
