- 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 Jan 18, 2025@03:38:39 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