TIUCOPP ;SLC/TDP - Copy/Paste Paste Tracking ;Jul 30, 2020@11:14:22
;;1.0;TEXT INTEGRATION UTILITIES;**290,336**;Jun 20, 1997;Build 4
;
; External Reference
; DBIA 10000 NOW^%DTC
; DBIA 2051 $$FIND1^DIC
; DBIA 2058 ^DIC(9.4
; DBIA 2053 UPDATE^DIE
; DBIA 10018 ^DIE
; DBIA 10060 ^VA(200,
; DBIA 2056 $$GET1^DIQ
; DBIA 10090 ^DIC(4
; DBIA 10035 ^DPT(
; DBIA 5771 ^OR(100
; DBIA 3260 ^LRT(67
; DBIA 3162 ^GMR(123 0;14 12;6
; DBIA 10103 NOW^XLFDT
; DBIA 10063 ^%ZTLOAD
; DBIA 10063 STAT^%ZTLOAD
;
PUTPASTE(INST,ARY,ERR,SVARY) ;Save Pasted Text
; Call using $$PUTPASTE^TIUCOPP(INST,.ARY,.ERR)
;
; Input
; INST - Institution ien (file #4)
; ARY - Array containing data to be saved into the Pasted Text file
; Components of ARY:
; ARY(1,0)=
; Piece 1: Input User DUZ
; Piece 2: Paste date/time (Fileman format "YYYMMDD.HHMMSS")
; Piece 3: Pasted to location (IEN;Package)
; GMRC = Consults (#123)
; TIU = Text Integration Utilities (#8925)
; OR = CPRS (#100)
; ??? = Other packages to be determined
; If only IEN is received (single data piece),
; will assume TIU Note IEN by default
; Piece 4: Copy from IEN;Package (1230;GMRC)
; GMRC = Consults (#123)
; TIU = Text Integration Utilities (#8925)
; OR = CPRS (#100)
; OUT = Outside of application
; ??? = Other packages to be determined
; -1 for an IEN will indicate free text value in second piece
; Piece 5: Percent match between copied text and pasted text
; Piece 6: Capturing application
; Piece 7: Edited Note IEN (Only if contains previous pasted text.
; Send -1 otherwise.)
; Piece 8: Force App to run find
; Piece 9: Not passed in, but is used to indicate parent when found
; pasted text is part of an entry
; ARY(1,0,1)= Copied text (Only if Pasted text is not 100% match)
; ARY(1,0,2)= Copied text
; ARY(1,0,n)= Copied text
; ARY(1,1)= Pasted text
; ARY(1,2)= Pasted text
; ARY(1,n)= Pasted text
; ARY(1,"PASTE",1,1)= Found Pasted text chunk 1
; ARY(1,"PASTE",1,2)= Found Pasted text chunk 1
; ARY(1,"PASTE",1,n)= Found Pasted text chunk 1
; ARY(1,"PASTE",2,1)= Found Pasted text chunk 2
; ARY(1,"PASTE",2,2)= Found Pasted text chunk 2
; ARY(1,"PASTE",2,n)= Found Pasted text chunk 2
; ARY(1,"PASTE",n,n)= Found Pasted text chunk 3...n
; ARY(2,0)= Next record (Same format as ARY(1,0))
; ARY(2,0,1)= Copied text
; ARY(2,1)= Pasted text
; ARY(2,"PASTE",1,1)= Found Pasted text
; ARY(N,n)
;
; ERR - Name of array to return error message in.
; SVARY - Array to receive saved paste info
;
; Output
; Boolean (1: Success, 0: Failed)
; ERR("ERR") - "-1^Error Message"
; Returned in variable received. If ERR variable not received,
; then TIUERR variable will be set and returned with the
; error message. If TIUERR is returned, calling routine will
; need to handle it properly.
; SVARY - Array returned containing ien of saved data
;
N %,%H,%I,CDTM,DATA,DAYS,DFN,TIUCNT,TIUCPDT,TMPARY,CPIEN,CPFIL,PRFX,SAVE
N TIUACNT,TIUNMSPC,TODATE,TXT,X,X1,X2,TIUCPRCD,TIULN,TIULNG,TXTDATA,PSV
N TIUPSTDT,PSTIEN,PSTFIL,CPLOC,FDA,FDAIEN,CDT,DATA0,DIERR,PCT,TIUERR
N TFSCNT,CPFTXT,PSTPCT,PARENT,PRNTARY,PSTFILNM,PSTFILGB,CPFILNM,SPST
N CAPP,PSTXTIEN,PSTLNG,NOFIND,PSTCALC,PRNTFND,PSTPCT,SMPST,C,Y
N CRGLN,FORCE
S SVARY=+$G(SVARY)
I SVARY<1 S SVARY=0
S PSTCALC=""
S PSTPCT=""
S TFSCNT=0
S TIUERR=""
S (PRNTARY,TMPARY)=""
S CRGLN="#13#10"
S SAVE=0
D NOW^%DTC
S CDTM=%
S CDT=X
I $G(INST)="" S INST=$G(DUZ(2))
I +INST<1 S TIUERR="-1^Invalid institution" G SVPSTQ
S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
I +INST<1 S TIUERR="-1^Invalid institution" G SVPSTQ
I '$D(ARY) S TIUERR="-1^Input array does not exist." G SVPSTQ
I $G(ARY(1,0))="" S TIUERR="-1^Zero node of received array is empty." G SVPSTQ
S SPST=$$PCT^TIUCOP(INST)*100
S TIUCPRCD=""
F S TIUCPRCD=$O(ARY(TIUCPRCD)) Q:TIUCPRCD="" D Q:+TIUERR=-1
. S DATA0=$G(ARY(TIUCPRCD,0))
. S PSTXTIEN=$P(DATA0,U,7)
. I $P($G(PSTXTIEN),"~",1)="NOCALC" D
.. S PSTCALC="NOCALC"
.. S PSTPCT=+$P($G(PSTXTIEN),"~",2)
.. S PSTXTIEN=0
. S PRNTFND=1
. I +PSTXTIEN>0 S PRNTFND=$$PRNTFND(.PSTXTIEN,TIUCPRCD,.ARY)
. Q:PRNTFND=0
. S DFN=$P(DATA0,U,1) I DFN="" S DFN=DUZ ;S TIUERR="-1^User dfn is required." Q
. I $$DFNCHK^TIUCOPUT(DFN)=0 S TIUERR="-1^User ien is not valid." Q
. S TIUPSTDT=$P(DATA0,U,2) I TIUPSTDT="" S TIUERR="-1^Paste date/time is required." Q
. I $$DTCHK^TIUCOPUT(TIUPSTDT)=0 S TIUERR="-1^Paste date is not valid." Q
. D UNQDT^TIUCOPUT(.TIUPSTDT)
. S PSTIEN=$P($P(DATA0,U,3),";",1)
. I PSTIEN="" S TIUERR="-1^Pasted to IEN is required." Q
. S PSTFILNM=""
. S PSTFIL=$P($P(DATA0,U,3),";",2) I PSTFIL=""!(PSTFIL="TIU") S PSTFIL="8925"
. I '$$GDFIL^TIUCOPUT(PSTIEN,.PSTFIL,.PSTFILNM) S TIUERR="-1^Pasted to file/ien is not valid." Q
. S CPFTXT=""
. S CPLOC=$P(DATA0,U,4) I CPLOC'="" D
.. S CPIEN=$P(CPLOC,";",1)
.. S CPFIL=$P(CPLOC,";",2,99)
.. S CPFIL=$S(CPFIL="GMRC":123,CPFIL="OR":100,CPFIL="TIU":8925,CPFIL="":8925,1:CPFIL)
.. S CPFILNM=""
.. I CPIEN=-1 S CPFTXT=CPFIL,CPFIL=""
.. I CPIEN=-1,CPFTXT="" S CPFTXT="Outside of current CPRS tracking"
. I CPFIL'="",'$$GDFIL^TIUCOPUT(CPIEN,.CPFIL,.CPFILNM) S TIUERR="-1^Copy from package/ien is not valid." Q
. I CPIEN=-1,CPFTXT="" S TIUERR="-1^Copy from free text identifier is empty." Q
. S CAPP=$P(DATA0,U,6) I $L(CAPP)>15 S CAPP=$E(CAPP,1,15)
. S PCT=+$P(DATA0,U,5) I PCT>100 S PCT=100
. S (X,TXT)=0
. F S X=$O(ARY(TIUCPRCD,X)) Q:+X=0 D Q:TXT=1 ;Remove leading blank lines
.. I $TR($G(ARY(TIUCPRCD,X))," ")]"" S TXT=1 Q
.. K ARY(TIUCPRCD,X)
. S TXT=0
. S X=999999999
. F S X=$O(ARY(TIUCPRCD,X),-1) Q:+X=0 D Q:TXT=1 ;Remove trailing blank lines
.. I $TR($G(ARY(TIUCPRCD,X))," ")]"" S TXT=1 Q
.. K ARY(TIUCPRCD,X)
. I +PSTXTIEN=-1,TXT=0 S TIUERR="-1^Pasted text contains no text" Q
. S X=0,PSTLNG=0,NOFIND=0
. S (TXT,TIUACNT,TIUCNT)=0
. F S X=$O(ARY(TIUCPRCD,X)) Q:+X=0 D
.. S TIUACNT=TIUACNT+1
.. S TIULNG=$L($G(ARY(TIUCPRCD,X)),"#13#10")
.. I TIULNG>1 D
... S TXTDATA=$G(ARY(TIUCPRCD,X))
... F TIULN=1:1:TIULNG D
.... S TIUCNT=TIUCNT+1
.... S TMPARY(TIUCNT)=$P(TXTDATA,"#13#10",TIULN)
.. I TIULNG=1 S TIUCNT=TIUCNT+1 S TMPARY(TIUCNT)=$G(ARY(TIUCPRCD,X))
. I TIUCNT>TIUACNT D
.. S TIULN=""
.. F S TIULN=$O(TMPARY(TIULN)) Q:TIULN="" D
... S ARY(TIUCPRCD,TIULN)=$G(TMPARY(TIULN))
. S FORCE=+$P(DATA0,U,8)
. I FORCE>2 S FORCE=0
. I FORCE<0 S FORCE=0
. S PARENT=+$P(DATA0,U,9)
. I PARENT=0 D RBLDARY^TIUCOPUT(.ARY,TIUCPRCD,CRGLN,PCT)
. S SMPST=0
. K C
. S C=""
. I +PSTXTIEN<1,PARENT=0 D
.. S SMPST=$$CPYTXT^TIUCOPUT(.ARY,TIUCPRCD,.C)
. D SVPST
I SVARY>0 S SVARY(0)=TFSCNT
I '$D(DIERR),$G(TIUERR)="" S SAVE=1
I $D(DIERR) D
. N ERRNM,ERRCNT,ERRTXT,LP
. S ERRTXT=""
. S TIUERR="-1^Error saving pasted text"
. S ERRNM=$P(DIERR,U,1)
. F ERRCNT=1:1:ERRNM D
.. S LP=0
.. F S LP=$O(^TMP("DIERR",$J,ERRCNT,"TEXT",LP)) Q:LP="" S ERRTXT=ERRTXT_$G(^TMP("DIERR",$J,ERRCNT,"TEXT",LP))
.. S TIUERR(ERRCNT)=$G(^TMP("DIERR",$J,ERRCNT))_"^"_ERRTXT
SVPSTQ I $G(TIUERR)'="" D
. S ERR("ERR")=$G(TIUERR)
. S X=""
. F S X=$O(TIUERR(X)) Q:X="" D
.. S ERR("ERR",X)=$G(TIUERR(X))
. K TIUERR
K ^TMP("DIERR",$J)
Q SAVE
;
PRNTFND(PSTXTIEN,TIUCPRCD,ARY) ;
N FND,CHLD,PRNT,STRLNG,X
S FND=0
I '$D(^TIUP(8928,PSTXTIEN,0)) D Q:FND=0 0
. S PRNT=""
. F S PRNT=$O(^TIUP(8928,"C",PRNT)) Q:PRNT="" D Q:FND=1
.. I '$D(^TIUP(8928,"C",PRNT,PSTXTIEN)) Q
.. S PSTXTIEN=PRNT
.. S FND=1
I $D(^TIUP(8928,"C",PSTXTIEN)) D Q 1
. D KLLCHLD(PSTXTIEN)
S PRNT=$P(^TIUP(8928,PSTXTIEN,0),U,11)
I +PRNT>0,$D(^TIUP(8928,PRNT,0)),$D(^TIUP(8928,PRNT,1)) D
. S PSTXTIEN=PRNT
. S FND=1
;I $D(^TIUP(8928,PSTXTIEN,1)) D
;. S X=0
;. F S X=$O(ARY(TIUCPRCD,X)) Q:+X=0 K ARY(TIUCPRCD,X)
;. S X=0
;. F S X=$O(^TIUP(8928,PSTXTIEN,1,X)) Q:X="" D
;.. S ARY(TIUCPRCD,X)=$G(^TIUP(8928,PSTXTIEN,1,X,0))
I '$G(ARY(TIUCPRCD,0,1)),$D(^TIUP(8928,PSTXTIEN,2)) D
. S X=0
. F S X=$O(^TIUP(8928,PSTXTIEN,2,X)) Q:X="" D
.. S ARY(TIUCPRCD,0,X)=$G(^TIUP(8928,PSTXTIEN,1,X,0))
D KLLCHLD(PSTXTIEN)
Q 1
;
KLLCHLD(PRNT) ;Kill off child paste entries
N DA,DIK
S DIK="^TIUP(8928,"
S DA=""
F S DA=$O(^TIUP(8928,"C",PRNT,DA)) Q:DA="" D ^DIK
Q
;
SVPST ;Save the paste information
;The following variables are expected to exist and are created
; in PUTPASTE^TIUCOPP which calls this code:
; CAPP,CPFIL,CPFTXT,CPIEN,DFN,FORCE,INST,PARENT,PCT,PRNTARY
; PSTFIL,PSTIEN,PSTXTIEN,SMPST,SVARY,TFSCNT,TIUCPRCD,TIUPSTDT
N DA,FDA,FDAIEN
S DA=""
S PRNTARY(TIUCPRCD)=$S(PARENT>0:PARENT,1:0)
I +PSTXTIEN>0 S FDAIEN(TIUCPRCD)=PSTXTIEN
I +PSTXTIEN'>0 D
. S FDA(8928,"+"_TIUCPRCD_",",.01)=TIUPSTDT
. S FDA(8928,"+"_TIUCPRCD_",",.02)=DFN
. S FDA(8928,"+"_TIUCPRCD_",",.03)=INST
. S FDA(8928,"+"_TIUCPRCD_",",.04)=PSTIEN
. S FDA(8928,"+"_TIUCPRCD_",",.05)=PSTFIL
. S FDA(8928,"+"_TIUCPRCD_",",.06)=$S(CPIEN=-1:"",1:CPIEN)
. S FDA(8928,"+"_TIUCPRCD_",",.07)=$S(CPIEN=-1:"",1:CPFIL)
. S FDA(8928,"+"_TIUCPRCD_",",.08)=$S(PCT=0:100,1:PCT) ;PCT
. S FDA(8928,"+"_TIUCPRCD_",",.09)=CAPP
. S FDA(8928,"+"_TIUCPRCD_",",.1)=$S(CPIEN=-1:CPIEN_";"_CPFTXT,1:"")
. S FDA(8928,"+"_TIUCPRCD_",",.12)=FORCE
. S FDA(8928,"+"_TIUCPRCD_",",1)="ARY("_TIUCPRCD_")"
. I $G(SMPST)=1 S FDA(8928,"+"_TIUCPRCD_",",2)="C"
. D UPDATE^DIE("","FDA","FDAIEN","")
. S DA=$G(FDAIEN(TIUCPRCD))
I +PSTXTIEN>0 D
. N SVPCT
. K FDA
. I '$D(^TIUP(8928,PSTXTIEN)) Q
. S SVPCT=$S(PCT=0:100,1:PCT)
. S FDA(8928,PSTXTIEN_",",.08)=SVPCT
. S FDA(8928,PSTXTIEN_",",.12)=FORCE
. D FILE^DIE("","FDA","")
I +PSTXTIEN>0,DA="" S DA=PSTXTIEN
I SVARY>0,+PARENT=0 D
. S SVARY(TIUCPRCD)=INST_U_DA
. S TFSCNT=TFSCNT+1
S PRNTARY(TIUCPRCD,0)=DA
I +PARENT>0,+DA>0 D
. N DIE,DR,NODE,PARENTDA
. S NODE=$G(PRNTARY(PARENT,0))
. S PARENTDA=$P(NODE,U,1)
. S DIE="^TIUP(8928,"
. S DR=".11///^S X=PARENTDA"
. D ^DIE
Q
;
GETPASTE(TIUIEN,INST,APP,ARY,ZERO) ;Retrieve pasted text
; Call using GETPASTE^TIUCOPP(NOTE IEN,INSTITUTION IEN,CALLING APPLICATION,.RETURN ARRAY)
;
; Input
; INST - Institution ien
; TIUIEN - Document ien and package (ien;file), ien only is TIU note
; APP - Application retrieving pasted text (Not used)
; ARY - Array to return the pasted text data
; ZERO - 1 = Return zero node only
;
; Output
; ARY(0,0) - Total number of unique entries
; Or
; Error condition "-1^Error Msg"
;
; ARY(1..n,0) - (If ZERO = 1, then only node returned)
; Piece 1: Date/Time of the paste
; Piece 2: User who pasted text
; Piece 3: Copy from location (ien;file)
; Piece 4: Copy from document title
; Piece 5: Copy from document author (duz;name(last,first m))
; Piece 6: Copy from Patient (dfn;name(last,first m))
; Piece 7: Percent match between copied text and pasted text
; Piece 8: Number of lines of pasted text
; Piece 9: Capturing Application
; Piece 10: Date/Time of the copy from document
; Piece 11: Saved Paste IEN
; Piece 12: Parent IEN
; Piece 13: Force Search
; (2=No Search,1=Yes,0=No)
; Piece 14: Pasted Note (#8925) IEN
; ARY(1,0,0) - Copy text line count
; ARY(1..n,0,1..n) - Copied text
; ARY(1..n,1..n) - Pasted text
;
N CNT,CPYDATA0,CPYDFN,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYFIL,CPYPTNAME
N CPYPTSRC,CPYUSER,DATA0,DTPST,IEN,LN,PCT,FILE,PRFX,PSTDUZ,PSTUSER
N TIUERR,TIUIENLN,TIUNMSPC,X,NODISP,CPYFILNM,CPYGBLEN,FILENM,CPYFTXT
N CPYLOC,CAPP,CPYSRCDT,PRNTIEN,TEXTLNG,COMPLT,FORCE
S TIUERR=""
I $G(ARY)'["" S TIUERR="-1^Return array is required." G GETPSTQ
I $G(INST)="" S INST=$G(DUZ(2))
I +INST<1 S TIUERR="-1^Invalid institution" G GETPSTQ
S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
I +INST<1 S TIUERR="-1^Invalid institution" G GETPSTQ
I $G(TIUIEN)="" S TIUERR="-1^Document ien is required." G GETPSTQ
S TIUIENLN=$L(TIUIEN,";")
S FILE=$S(TIUIENLN>1:$P($G(TIUIEN),";",2),1:"8925")
S TIUIEN=$P($G(TIUIEN),";",1)
I FILE=""!(FILE="TIU") S FILE="8925"
I TIUIEN="" S TIUERR="-1^Document IEN is required." G GETPSTQ
I '$$GDFIL^TIUCOPUT(TIUIEN,.FILE,.FILENM) S TIUERR="-1^Document file/ien is not valid." G GETPSTQ
S CNT=$S(+$G(ARY(0,0))'<0:+$G(ARY(0,0)),1:0)
S DTPST=""
F S DTPST=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST)) Q:DTPST="" D
. S IEN=""
. F S IEN=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST,IEN)) Q:IEN="" D
.. S CPYDATA0=""
.. S DATA0=$G(^TIUP(8928,IEN,0))
.. I DATA0="" Q
.. S PSTDUZ=$P(DATA0,U,2)
.. I +PSTDUZ>0 S PSTUSER=$$GET1^DIQ(200,PSTDUZ_",",.01)
.. I PSTUSER="" S PSTUSER="UNKNOWN PASTER NAME"
.. S CPYIEN=$P(DATA0,U,6)
.. S CPYFIL=$P(DATA0,U,7)
.. I CPYIEN>0,CPYFIL="" S CPYFIL=8925
.. S CAPP=$P(DATA0,U,9)
.. S PRNTIEN=$P(DATA0,U,11)
.. I PRNTIEN="",$D(^TIUP(8928,"C",IEN)) S PRNTIEN="+"
.. S FORCE=$P(DATA0,U,12)
.. S CPYLOC=""
.. S CPYFILNM=""
.. S CPYFTXT=""
.. I CPYFIL'="" D
... S CPYFILNM=$$GET1^DIQ(1,CPYFIL_",",.01)
... S CPYGBL=$$GET1^DIQ(1,CPYFIL_",",1)
... S CPYGBLEN=CPYGBL_CPYIEN_")"
.. I CPYIEN="" D
... S CPYFTXT=$P(DATA0,U,10)
... I $P(CPYFTXT," - ",1)="ORDER DETAILS" D
.... S CPYIEN=$P($P(CPYFIL," - ",2),";",1)
.... S CPYFIL=100
.. S PCT=$P(DATA0,U,8)
.. S CPYPTSRC=""
.. S CPYNAME=""
.. S CPYUSER=""
.. S CPYPTNAME=""
.. S CPYDUZ=""
.. S CPYUSER=""
.. S CPYDFN=""
.. S CPYSRCDT=""
.. I CPYFILNM="TIU DOCUMENT" D
... S CPYSRCDT=$P($G(^TIU(8925,CPYIEN,13)),U,1) ;REFERENCE DATE
... S CPYDUZ=$P($G(^TIU(CPYFIL,CPYIEN,12)),U,2) ;AUTHOR/DICTATOR
... I +CPYDUZ=0 S CPYDUZ=$P($G(^TIU(CPYFIL,CPYIEN,13)),U,2) ;ENTERED BY
... I +CPYDUZ>0 S CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
... I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
... S CPYDATA0=$G(^TIU(CPYFIL,CPYIEN,0))
... I $G(CPYDATA0)="" Q
... S CPYNAME=$P(CPYDATA0,U,1)
... S CPYNAME=$P($G(^TIU(8925.1,CPYNAME,0)),U,1)
... I CPYNAME="" S CPYNAME="UNKNOWN NOTE TITLE"
... S CPYDFN=$P(CPYDATA0,U,2)
... I +CPYDFN>0 S CPYPTNAME=$P($G(^DPT(CPYDFN,0)),U,1)
... I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
.. I CPYFIL="100" D
... S CPYDATA0=$G(^OR(CPYFIL,CPYIEN,0))
... I $G(CPYDATA0)="" Q
... S CPYSRCDT=$P(CPYDATA0,U,7)
... S CPYDUZ=$P(CPYDATA0,U,6) ;WHO ENTERED
... I +CPYDUZ>0 S CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
... I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
... S CPYNAME="ORDER #"_$P(CPYDATA0,U,1)
... I +$P(CPYNAME,"#",2)=0 S CPYNAME="UNKNOWN ORDER NUMBER"
... S CPYDFN=$P(CPYDATA0,U,2) ;ORDERABLE ITEMS (PATIENT/REFERRAL)
... I +CPYDFN>0 D
.... S CPYGBL=$P(CPYDFN,";",2)
.... S CPYDFN=+CPYDFN
... I CPYGBL="DPT(" S CPYPTNAME=$P($G(^DPT(CPYDFN,0)),U,1)
... ;I CPYGBL="LRT(67," S CPYPTNAME=$P($G(^LRT(67,CPYDFN,0)),U,1),CPYPTSRC="R"
... I CPYGBL="LRT(67," D
.... S CPYPTNAME=$$GET1^DIQ(67,CPYDFN_",",.01)
.... S CPYPTSRC="R"
... I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
.. I CPYFILNM="REQUEST/CONSULTATION" D
... S CPYDATA0=$G(^GMR(CPYFIL,CPYIEN,0))
... I $G(CPYDATA0)="" Q
... S CPYSRCDT=$P(CPYDATA0,U,1)
... S CPYDUZ=$P(CPYDATA0,U,14) ;SENDING PROVIDER
... I +CPYDUZ>0 S CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
... I +CPYDUZ<1,$P($G(^GMR(CPYFIL,CPYIEN,12)),U,6)'="" S CPYUSER=$P($G(^GMR(CPYFIL,CPYIEN,12)),U,6),CPYDUZ="IFC"
... I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
... S CPYNAME="CONSULT #"_CPYIEN
... I +$P(CPYNAME,"#",2)=0 S CPYNAME="UNKNOWN CONSULT NUMBER"
... S CPYDFN=$P(CPYDATA0,U,2) ;PATIENT NAME (IEN)
... I +CPYDFN>0 S CPYPTNAME=$P($G(^DPT(CPYDFN,0)),U,1)
... I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
.. I $G(CPYDATA0)="",CPYFTXT="" Q
.. S CPYLOC=$S(CPYIEN'="":CPYIEN_";"_CPYFILNM,1:CPYFTXT)
.. S CNT=CNT+1
.. S ARY(CNT,0)=DTPST_U_$S(+PSTDUZ>0:+PSTDUZ_";"_PSTUSER,1:"")_U_CPYLOC
.. S ARY(CNT,0)=$G(ARY(CNT,0))_U_CPYNAME_U
.. S ARY(CNT,0)=$G(ARY(CNT,0))_$S(+CPYDUZ>0:+CPYDUZ_";"_CPYUSER,1:"")
.. S ARY(CNT,0)=$G(ARY(CNT,0))_U_$S(+CPYDFN>0:+CPYDFN_";"_CPYPTNAME,1:"")
.. S ARY(CNT,0)=$G(ARY(CNT,0))_$S(((CPYPTSRC="R")&(CPYPTSRC'="")):";"_CPYPTSRC,1:"")
.. S ARY(CNT,0)=$G(ARY(CNT,0))_U_PCT_U_U_CAPP_U_CPYSRCDT_U_IEN_U_PRNTIEN_U_FORCE_U_TIUIEN
.. IF +ZERO=1 Q
.. S LN=0
.. S X=""
.. F S X=$O(^TIUP(8928,IEN,1,X)) Q:X="" D
... I X=0 S LN=$P($G(^TIUP(8928,IEN,1,X)),U,4) Q
... S ARY(CNT,X)=$G(^TIUP(8928,IEN,1,X,0))
.. S $P(ARY(CNT,0),U,8)=LN
.. S LN=0
.. S X=""
.. F S X=$O(^TIUP(8928,IEN,2,X)) Q:X="" D
... I X=0 S LN=$P($G(^TIUP(8928,IEN,2,X)),U,4) Q
... S ARY(CNT,0,X)=$G(^TIUP(8928,IEN,2,X,0))
.. I +LN>0 S ARY(CNT,0,0)=LN
S ARY(0,0)=CNT
GETPSTQ I TIUERR'="" S ARY(0,0)=TIUERR
Q
;
CHKPASTE(TIUIEN,INST) ;Check pasted text exists for a document
; Call using $$CHKPASTE^TIUCOPP(DOCUMENT IDENTIFIER,INSTITUTION IEN)
;
; Input
; INST - Institution ien
; TIUIEN - Document ien and file # (ien;file), ien only is TIU note
;
; Output
; BOOLEAN - 1 Pasted Text Available
; 0 No Pasted Text
;
N DTPST,ERR,FILE,FILENM,IEN,RSLT,TIUIENLN
S RSLT=0
I $G(INST)="" S INST=$G(DUZ(2))
I +INST<1 Q RSLT
S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
I +INST<1 Q RSLT
I $G(TIUIEN)="" Q RSLT
S TIUIENLN=$L(TIUIEN,";")
S FILE=$S(TIUIENLN>1:$P($G(TIUIEN),";",2),1:"8925")
S TIUIEN=$P($G(TIUIEN),";",1)
I FILE=""!(FILE="TIU") S FILE="8925"
I TIUIEN="" Q RSLT
I '$$GDFIL^TIUCOPUT(TIUIEN,.FILE,.FILENM) Q RSLT
S DTPST=""
F S DTPST=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST)) Q:DTPST="" D Q:RSLT
. S IEN=""
. F S IEN=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST,IEN)) Q:IEN="" D Q:RSLT
.. I $G(^TIUP(8928,IEN,0))="" Q
.. S RSLT=1 Q
Q RSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCOPP 18646 printed Dec 13, 2024@02:39:22 Page 2
TIUCOPP ;SLC/TDP - Copy/Paste Paste Tracking ;Jul 30, 2020@11:14:22
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**290,336**;Jun 20, 1997;Build 4
+2 ;
+3 ; External Reference
+4 ; DBIA 10000 NOW^%DTC
+5 ; DBIA 2051 $$FIND1^DIC
+6 ; DBIA 2058 ^DIC(9.4
+7 ; DBIA 2053 UPDATE^DIE
+8 ; DBIA 10018 ^DIE
+9 ; DBIA 10060 ^VA(200,
+10 ; DBIA 2056 $$GET1^DIQ
+11 ; DBIA 10090 ^DIC(4
+12 ; DBIA 10035 ^DPT(
+13 ; DBIA 5771 ^OR(100
+14 ; DBIA 3260 ^LRT(67
+15 ; DBIA 3162 ^GMR(123 0;14 12;6
+16 ; DBIA 10103 NOW^XLFDT
+17 ; DBIA 10063 ^%ZTLOAD
+18 ; DBIA 10063 STAT^%ZTLOAD
+19 ;
PUTPASTE(INST,ARY,ERR,SVARY) ;Save Pasted Text
+1 ; Call using $$PUTPASTE^TIUCOPP(INST,.ARY,.ERR)
+2 ;
+3 ; Input
+4 ; INST - Institution ien (file #4)
+5 ; ARY - Array containing data to be saved into the Pasted Text file
+6 ; Components of ARY:
+7 ; ARY(1,0)=
+8 ; Piece 1: Input User DUZ
+9 ; Piece 2: Paste date/time (Fileman format "YYYMMDD.HHMMSS")
+10 ; Piece 3: Pasted to location (IEN;Package)
+11 ; GMRC = Consults (#123)
+12 ; TIU = Text Integration Utilities (#8925)
+13 ; OR = CPRS (#100)
+14 ; ??? = Other packages to be determined
+15 ; If only IEN is received (single data piece),
+16 ; will assume TIU Note IEN by default
+17 ; Piece 4: Copy from IEN;Package (1230;GMRC)
+18 ; GMRC = Consults (#123)
+19 ; TIU = Text Integration Utilities (#8925)
+20 ; OR = CPRS (#100)
+21 ; OUT = Outside of application
+22 ; ??? = Other packages to be determined
+23 ; -1 for an IEN will indicate free text value in second piece
+24 ; Piece 5: Percent match between copied text and pasted text
+25 ; Piece 6: Capturing application
+26 ; Piece 7: Edited Note IEN (Only if contains previous pasted text.
+27 ; Send -1 otherwise.)
+28 ; Piece 8: Force App to run find
+29 ; Piece 9: Not passed in, but is used to indicate parent when found
+30 ; pasted text is part of an entry
+31 ; ARY(1,0,1)= Copied text (Only if Pasted text is not 100% match)
+32 ; ARY(1,0,2)= Copied text
+33 ; ARY(1,0,n)= Copied text
+34 ; ARY(1,1)= Pasted text
+35 ; ARY(1,2)= Pasted text
+36 ; ARY(1,n)= Pasted text
+37 ; ARY(1,"PASTE",1,1)= Found Pasted text chunk 1
+38 ; ARY(1,"PASTE",1,2)= Found Pasted text chunk 1
+39 ; ARY(1,"PASTE",1,n)= Found Pasted text chunk 1
+40 ; ARY(1,"PASTE",2,1)= Found Pasted text chunk 2
+41 ; ARY(1,"PASTE",2,2)= Found Pasted text chunk 2
+42 ; ARY(1,"PASTE",2,n)= Found Pasted text chunk 2
+43 ; ARY(1,"PASTE",n,n)= Found Pasted text chunk 3...n
+44 ; ARY(2,0)= Next record (Same format as ARY(1,0))
+45 ; ARY(2,0,1)= Copied text
+46 ; ARY(2,1)= Pasted text
+47 ; ARY(2,"PASTE",1,1)= Found Pasted text
+48 ; ARY(N,n)
+49 ;
+50 ; ERR - Name of array to return error message in.
+51 ; SVARY - Array to receive saved paste info
+52 ;
+53 ; Output
+54 ; Boolean (1: Success, 0: Failed)
+55 ; ERR("ERR") - "-1^Error Message"
+56 ; Returned in variable received. If ERR variable not received,
+57 ; then TIUERR variable will be set and returned with the
+58 ; error message. If TIUERR is returned, calling routine will
+59 ; need to handle it properly.
+60 ; SVARY - Array returned containing ien of saved data
+61 ;
+62 NEW %,%H,%I,CDTM,DATA,DAYS,DFN,TIUCNT,TIUCPDT,TMPARY,CPIEN,CPFIL,PRFX,SAVE
+63 NEW TIUACNT,TIUNMSPC,TODATE,TXT,X,X1,X2,TIUCPRCD,TIULN,TIULNG,TXTDATA,PSV
+64 NEW TIUPSTDT,PSTIEN,PSTFIL,CPLOC,FDA,FDAIEN,CDT,DATA0,DIERR,PCT,TIUERR
+65 NEW TFSCNT,CPFTXT,PSTPCT,PARENT,PRNTARY,PSTFILNM,PSTFILGB,CPFILNM,SPST
+66 NEW CAPP,PSTXTIEN,PSTLNG,NOFIND,PSTCALC,PRNTFND,PSTPCT,SMPST,C,Y
+67 NEW CRGLN,FORCE
+68 SET SVARY=+$GET(SVARY)
+69 IF SVARY<1
SET SVARY=0
+70 SET PSTCALC=""
+71 SET PSTPCT=""
+72 SET TFSCNT=0
+73 SET TIUERR=""
+74 SET (PRNTARY,TMPARY)=""
+75 SET CRGLN="#13#10"
+76 SET SAVE=0
+77 DO NOW^%DTC
+78 SET CDTM=%
+79 SET CDT=X
+80 IF $GET(INST)=""
SET INST=$GET(DUZ(2))
+81 IF +INST<1
SET TIUERR="-1^Invalid institution"
GOTO SVPSTQ
+82 SET INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
+83 IF +INST<1
SET TIUERR="-1^Invalid institution"
GOTO SVPSTQ
+84 IF '$DATA(ARY)
SET TIUERR="-1^Input array does not exist."
GOTO SVPSTQ
+85 IF $GET(ARY(1,0))=""
SET TIUERR="-1^Zero node of received array is empty."
GOTO SVPSTQ
+86 SET SPST=$$PCT^TIUCOP(INST)*100
+87 SET TIUCPRCD=""
+88 FOR
SET TIUCPRCD=$ORDER(ARY(TIUCPRCD))
if TIUCPRCD=""
QUIT
Begin DoDot:1
+89 SET DATA0=$GET(ARY(TIUCPRCD,0))
+90 SET PSTXTIEN=$PIECE(DATA0,U,7)
+91 IF $PIECE($GET(PSTXTIEN),"~",1)="NOCALC"
Begin DoDot:2
+92 SET PSTCALC="NOCALC"
+93 SET PSTPCT=+$PIECE($GET(PSTXTIEN),"~",2)
+94 SET PSTXTIEN=0
End DoDot:2
+95 SET PRNTFND=1
+96 IF +PSTXTIEN>0
SET PRNTFND=$$PRNTFND(.PSTXTIEN,TIUCPRCD,.ARY)
+97 if PRNTFND=0
QUIT
+98 ;S TIUERR="-1^User dfn is required." Q
SET DFN=$PIECE(DATA0,U,1)
IF DFN=""
SET DFN=DUZ
+99 IF $$DFNCHK^TIUCOPUT(DFN)=0
SET TIUERR="-1^User ien is not valid."
QUIT
+100 SET TIUPSTDT=$PIECE(DATA0,U,2)
IF TIUPSTDT=""
SET TIUERR="-1^Paste date/time is required."
QUIT
+101 IF $$DTCHK^TIUCOPUT(TIUPSTDT)=0
SET TIUERR="-1^Paste date is not valid."
QUIT
+102 DO UNQDT^TIUCOPUT(.TIUPSTDT)
+103 SET PSTIEN=$PIECE($PIECE(DATA0,U,3),";",1)
+104 IF PSTIEN=""
SET TIUERR="-1^Pasted to IEN is required."
QUIT
+105 SET PSTFILNM=""
+106 SET PSTFIL=$PIECE($PIECE(DATA0,U,3),";",2)
IF PSTFIL=""!(PSTFIL="TIU")
SET PSTFIL="8925"
+107 IF '$$GDFIL^TIUCOPUT(PSTIEN,.PSTFIL,.PSTFILNM)
SET TIUERR="-1^Pasted to file/ien is not valid."
QUIT
+108 SET CPFTXT=""
+109 SET CPLOC=$PIECE(DATA0,U,4)
IF CPLOC'=""
Begin DoDot:2
+110 SET CPIEN=$PIECE(CPLOC,";",1)
+111 SET CPFIL=$PIECE(CPLOC,";",2,99)
+112 SET CPFIL=$SELECT(CPFIL="GMRC":123,CPFIL="OR":100,CPFIL="TIU":8925,CPFIL="":8925,1:CPFIL)
+113 SET CPFILNM=""
+114 IF CPIEN=-1
SET CPFTXT=CPFIL
SET CPFIL=""
+115 IF CPIEN=-1
IF CPFTXT=""
SET CPFTXT="Outside of current CPRS tracking"
End DoDot:2
+116 IF CPFIL'=""
IF '$$GDFIL^TIUCOPUT(CPIEN,.CPFIL,.CPFILNM)
SET TIUERR="-1^Copy from package/ien is not valid."
QUIT
+117 IF CPIEN=-1
IF CPFTXT=""
SET TIUERR="-1^Copy from free text identifier is empty."
QUIT
+118 SET CAPP=$PIECE(DATA0,U,6)
IF $LENGTH(CAPP)>15
SET CAPP=$EXTRACT(CAPP,1,15)
+119 SET PCT=+$PIECE(DATA0,U,5)
IF PCT>100
SET PCT=100
+120 SET (X,TXT)=0
+121 ;Remove leading blank lines
FOR
SET X=$ORDER(ARY(TIUCPRCD,X))
if +X=0
QUIT
Begin DoDot:2
+122 IF $TRANSLATE($GET(ARY(TIUCPRCD,X))," ")]""
SET TXT=1
QUIT
+123 KILL ARY(TIUCPRCD,X)
End DoDot:2
if TXT=1
QUIT
+124 SET TXT=0
+125 SET X=999999999
+126 ;Remove trailing blank lines
FOR
SET X=$ORDER(ARY(TIUCPRCD,X),-1)
if +X=0
QUIT
Begin DoDot:2
+127 IF $TRANSLATE($GET(ARY(TIUCPRCD,X))," ")]""
SET TXT=1
QUIT
+128 KILL ARY(TIUCPRCD,X)
End DoDot:2
if TXT=1
QUIT
+129 IF +PSTXTIEN=-1
IF TXT=0
SET TIUERR="-1^Pasted text contains no text"
QUIT
+130 SET X=0
SET PSTLNG=0
SET NOFIND=0
+131 SET (TXT,TIUACNT,TIUCNT)=0
+132 FOR
SET X=$ORDER(ARY(TIUCPRCD,X))
if +X=0
QUIT
Begin DoDot:2
+133 SET TIUACNT=TIUACNT+1
+134 SET TIULNG=$LENGTH($GET(ARY(TIUCPRCD,X)),"#13#10")
+135 IF TIULNG>1
Begin DoDot:3
+136 SET TXTDATA=$GET(ARY(TIUCPRCD,X))
+137 FOR TIULN=1:1:TIULNG
Begin DoDot:4
+138 SET TIUCNT=TIUCNT+1
+139 SET TMPARY(TIUCNT)=$PIECE(TXTDATA,"#13#10",TIULN)
End DoDot:4
End DoDot:3
+140 IF TIULNG=1
SET TIUCNT=TIUCNT+1
SET TMPARY(TIUCNT)=$GET(ARY(TIUCPRCD,X))
End DoDot:2
+141 IF TIUCNT>TIUACNT
Begin DoDot:2
+142 SET TIULN=""
+143 FOR
SET TIULN=$ORDER(TMPARY(TIULN))
if TIULN=""
QUIT
Begin DoDot:3
+144 SET ARY(TIUCPRCD,TIULN)=$GET(TMPARY(TIULN))
End DoDot:3
End DoDot:2
+145 SET FORCE=+$PIECE(DATA0,U,8)
+146 IF FORCE>2
SET FORCE=0
+147 IF FORCE<0
SET FORCE=0
+148 SET PARENT=+$PIECE(DATA0,U,9)
+149 IF PARENT=0
DO RBLDARY^TIUCOPUT(.ARY,TIUCPRCD,CRGLN,PCT)
+150 SET SMPST=0
+151 KILL C
+152 SET C=""
+153 IF +PSTXTIEN<1
IF PARENT=0
Begin DoDot:2
+154 SET SMPST=$$CPYTXT^TIUCOPUT(.ARY,TIUCPRCD,.C)
End DoDot:2
+155 DO SVPST
End DoDot:1
if +TIUERR=-1
QUIT
+156 IF SVARY>0
SET SVARY(0)=TFSCNT
+157 IF '$DATA(DIERR)
IF $GET(TIUERR)=""
SET SAVE=1
+158 IF $DATA(DIERR)
Begin DoDot:1
+159 NEW ERRNM,ERRCNT,ERRTXT,LP
+160 SET ERRTXT=""
+161 SET TIUERR="-1^Error saving pasted text"
+162 SET ERRNM=$PIECE(DIERR,U,1)
+163 FOR ERRCNT=1:1:ERRNM
Begin DoDot:2
+164 SET LP=0
+165 FOR
SET LP=$ORDER(^TMP("DIERR",$JOB,ERRCNT,"TEXT",LP))
if LP=""
QUIT
SET ERRTXT=ERRTXT_$GET(^TMP("DIERR",$JOB,ERRCNT,"TEXT",LP))
+166 SET TIUERR(ERRCNT)=$GET(^TMP("DIERR",$JOB,ERRCNT))_"^"_ERRTXT
End DoDot:2
End DoDot:1
SVPSTQ IF $GET(TIUERR)'=""
Begin DoDot:1
+1 SET ERR("ERR")=$GET(TIUERR)
+2 SET X=""
+3 FOR
SET X=$ORDER(TIUERR(X))
if X=""
QUIT
Begin DoDot:2
+4 SET ERR("ERR",X)=$GET(TIUERR(X))
End DoDot:2
+5 KILL TIUERR
End DoDot:1
+6 KILL ^TMP("DIERR",$JOB)
+7 QUIT SAVE
+8 ;
PRNTFND(PSTXTIEN,TIUCPRCD,ARY) ;
+1 NEW FND,CHLD,PRNT,STRLNG,X
+2 SET FND=0
+3 IF '$DATA(^TIUP(8928,PSTXTIEN,0))
Begin DoDot:1
+4 SET PRNT=""
+5 FOR
SET PRNT=$ORDER(^TIUP(8928,"C",PRNT))
if PRNT=""
QUIT
Begin DoDot:2
+6 IF '$DATA(^TIUP(8928,"C",PRNT,PSTXTIEN))
QUIT
+7 SET PSTXTIEN=PRNT
+8 SET FND=1
End DoDot:2
if FND=1
QUIT
End DoDot:1
if FND=0
QUIT 0
+9 IF $DATA(^TIUP(8928,"C",PSTXTIEN))
Begin DoDot:1
+10 DO KLLCHLD(PSTXTIEN)
End DoDot:1
QUIT 1
+11 SET PRNT=$PIECE(^TIUP(8928,PSTXTIEN,0),U,11)
+12 IF +PRNT>0
IF $DATA(^TIUP(8928,PRNT,0))
IF $DATA(^TIUP(8928,PRNT,1))
Begin DoDot:1
+13 SET PSTXTIEN=PRNT
+14 SET FND=1
End DoDot:1
+15 ;I $D(^TIUP(8928,PSTXTIEN,1)) D
+16 ;. S X=0
+17 ;. F S X=$O(ARY(TIUCPRCD,X)) Q:+X=0 K ARY(TIUCPRCD,X)
+18 ;. S X=0
+19 ;. F S X=$O(^TIUP(8928,PSTXTIEN,1,X)) Q:X="" D
+20 ;.. S ARY(TIUCPRCD,X)=$G(^TIUP(8928,PSTXTIEN,1,X,0))
+21 IF '$GET(ARY(TIUCPRCD,0,1))
IF $DATA(^TIUP(8928,PSTXTIEN,2))
Begin DoDot:1
+22 SET X=0
+23 FOR
SET X=$ORDER(^TIUP(8928,PSTXTIEN,2,X))
if X=""
QUIT
Begin DoDot:2
+24 SET ARY(TIUCPRCD,0,X)=$GET(^TIUP(8928,PSTXTIEN,1,X,0))
End DoDot:2
End DoDot:1
+25 DO KLLCHLD(PSTXTIEN)
+26 QUIT 1
+27 ;
KLLCHLD(PRNT) ;Kill off child paste entries
+1 NEW DA,DIK
+2 SET DIK="^TIUP(8928,"
+3 SET DA=""
+4 FOR
SET DA=$ORDER(^TIUP(8928,"C",PRNT,DA))
if DA=""
QUIT
DO ^DIK
+5 QUIT
+6 ;
SVPST ;Save the paste information
+1 ;The following variables are expected to exist and are created
+2 ; in PUTPASTE^TIUCOPP which calls this code:
+3 ; CAPP,CPFIL,CPFTXT,CPIEN,DFN,FORCE,INST,PARENT,PCT,PRNTARY
+4 ; PSTFIL,PSTIEN,PSTXTIEN,SMPST,SVARY,TFSCNT,TIUCPRCD,TIUPSTDT
+5 NEW DA,FDA,FDAIEN
+6 SET DA=""
+7 SET PRNTARY(TIUCPRCD)=$SELECT(PARENT>0:PARENT,1:0)
+8 IF +PSTXTIEN>0
SET FDAIEN(TIUCPRCD)=PSTXTIEN
+9 IF +PSTXTIEN'>0
Begin DoDot:1
+10 SET FDA(8928,"+"_TIUCPRCD_",",.01)=TIUPSTDT
+11 SET FDA(8928,"+"_TIUCPRCD_",",.02)=DFN
+12 SET FDA(8928,"+"_TIUCPRCD_",",.03)=INST
+13 SET FDA(8928,"+"_TIUCPRCD_",",.04)=PSTIEN
+14 SET FDA(8928,"+"_TIUCPRCD_",",.05)=PSTFIL
+15 SET FDA(8928,"+"_TIUCPRCD_",",.06)=$SELECT(CPIEN=-1:"",1:CPIEN)
+16 SET FDA(8928,"+"_TIUCPRCD_",",.07)=$SELECT(CPIEN=-1:"",1:CPFIL)
+17 ;PCT
SET FDA(8928,"+"_TIUCPRCD_",",.08)=$SELECT(PCT=0:100,1:PCT)
+18 SET FDA(8928,"+"_TIUCPRCD_",",.09)=CAPP
+19 SET FDA(8928,"+"_TIUCPRCD_",",.1)=$SELECT(CPIEN=-1:CPIEN_";"_CPFTXT,1:"")
+20 SET FDA(8928,"+"_TIUCPRCD_",",.12)=FORCE
+21 SET FDA(8928,"+"_TIUCPRCD_",",1)="ARY("_TIUCPRCD_")"
+22 IF $GET(SMPST)=1
SET FDA(8928,"+"_TIUCPRCD_",",2)="C"
+23 DO UPDATE^DIE("","FDA","FDAIEN","")
+24 SET DA=$GET(FDAIEN(TIUCPRCD))
End DoDot:1
+25 IF +PSTXTIEN>0
Begin DoDot:1
+26 NEW SVPCT
+27 KILL FDA
+28 IF '$DATA(^TIUP(8928,PSTXTIEN))
QUIT
+29 SET SVPCT=$SELECT(PCT=0:100,1:PCT)
+30 SET FDA(8928,PSTXTIEN_",",.08)=SVPCT
+31 SET FDA(8928,PSTXTIEN_",",.12)=FORCE
+32 DO FILE^DIE("","FDA","")
End DoDot:1
+33 IF +PSTXTIEN>0
IF DA=""
SET DA=PSTXTIEN
+34 IF SVARY>0
IF +PARENT=0
Begin DoDot:1
+35 SET SVARY(TIUCPRCD)=INST_U_DA
+36 SET TFSCNT=TFSCNT+1
End DoDot:1
+37 SET PRNTARY(TIUCPRCD,0)=DA
+38 IF +PARENT>0
IF +DA>0
Begin DoDot:1
+39 NEW DIE,DR,NODE,PARENTDA
+40 SET NODE=$GET(PRNTARY(PARENT,0))
+41 SET PARENTDA=$PIECE(NODE,U,1)
+42 SET DIE="^TIUP(8928,"
+43 SET DR=".11///^S X=PARENTDA"
+44 DO ^DIE
End DoDot:1
+45 QUIT
+46 ;
GETPASTE(TIUIEN,INST,APP,ARY,ZERO) ;Retrieve pasted text
+1 ; Call using GETPASTE^TIUCOPP(NOTE IEN,INSTITUTION IEN,CALLING APPLICATION,.RETURN ARRAY)
+2 ;
+3 ; Input
+4 ; INST - Institution ien
+5 ; TIUIEN - Document ien and package (ien;file), ien only is TIU note
+6 ; APP - Application retrieving pasted text (Not used)
+7 ; ARY - Array to return the pasted text data
+8 ; ZERO - 1 = Return zero node only
+9 ;
+10 ; Output
+11 ; ARY(0,0) - Total number of unique entries
+12 ; Or
+13 ; Error condition "-1^Error Msg"
+14 ;
+15 ; ARY(1..n,0) - (If ZERO = 1, then only node returned)
+16 ; Piece 1: Date/Time of the paste
+17 ; Piece 2: User who pasted text
+18 ; Piece 3: Copy from location (ien;file)
+19 ; Piece 4: Copy from document title
+20 ; Piece 5: Copy from document author (duz;name(last,first m))
+21 ; Piece 6: Copy from Patient (dfn;name(last,first m))
+22 ; Piece 7: Percent match between copied text and pasted text
+23 ; Piece 8: Number of lines of pasted text
+24 ; Piece 9: Capturing Application
+25 ; Piece 10: Date/Time of the copy from document
+26 ; Piece 11: Saved Paste IEN
+27 ; Piece 12: Parent IEN
+28 ; Piece 13: Force Search
+29 ; (2=No Search,1=Yes,0=No)
+30 ; Piece 14: Pasted Note (#8925) IEN
+31 ; ARY(1,0,0) - Copy text line count
+32 ; ARY(1..n,0,1..n) - Copied text
+33 ; ARY(1..n,1..n) - Pasted text
+34 ;
+35 NEW CNT,CPYDATA0,CPYDFN,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYFIL,CPYPTNAME
+36 NEW CPYPTSRC,CPYUSER,DATA0,DTPST,IEN,LN,PCT,FILE,PRFX,PSTDUZ,PSTUSER
+37 NEW TIUERR,TIUIENLN,TIUNMSPC,X,NODISP,CPYFILNM,CPYGBLEN,FILENM,CPYFTXT
+38 NEW CPYLOC,CAPP,CPYSRCDT,PRNTIEN,TEXTLNG,COMPLT,FORCE
+39 SET TIUERR=""
+40 IF $GET(ARY)'[""
SET TIUERR="-1^Return array is required."
GOTO GETPSTQ
+41 IF $GET(INST)=""
SET INST=$GET(DUZ(2))
+42 IF +INST<1
SET TIUERR="-1^Invalid institution"
GOTO GETPSTQ
+43 SET INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
+44 IF +INST<1
SET TIUERR="-1^Invalid institution"
GOTO GETPSTQ
+45 IF $GET(TIUIEN)=""
SET TIUERR="-1^Document ien is required."
GOTO GETPSTQ
+46 SET TIUIENLN=$LENGTH(TIUIEN,";")
+47 SET FILE=$SELECT(TIUIENLN>1:$PIECE($GET(TIUIEN),";",2),1:"8925")
+48 SET TIUIEN=$PIECE($GET(TIUIEN),";",1)
+49 IF FILE=""!(FILE="TIU")
SET FILE="8925"
+50 IF TIUIEN=""
SET TIUERR="-1^Document IEN is required."
GOTO GETPSTQ
+51 IF '$$GDFIL^TIUCOPUT(TIUIEN,.FILE,.FILENM)
SET TIUERR="-1^Document file/ien is not valid."
GOTO GETPSTQ
+52 SET CNT=$SELECT(+$GET(ARY(0,0))'<0:+$GET(ARY(0,0)),1:0)
+53 SET DTPST=""
+54 FOR
SET DTPST=$ORDER(^TIUP(8928,"AC",TIUIEN,FILE,DTPST))
if DTPST=""
QUIT
Begin DoDot:1
+55 SET IEN=""
+56 FOR
SET IEN=$ORDER(^TIUP(8928,"AC",TIUIEN,FILE,DTPST,IEN))
if IEN=""
QUIT
Begin DoDot:2
+57 SET CPYDATA0=""
+58 SET DATA0=$GET(^TIUP(8928,IEN,0))
+59 IF DATA0=""
QUIT
+60 SET PSTDUZ=$PIECE(DATA0,U,2)
+61 IF +PSTDUZ>0
SET PSTUSER=$$GET1^DIQ(200,PSTDUZ_",",.01)
+62 IF PSTUSER=""
SET PSTUSER="UNKNOWN PASTER NAME"
+63 SET CPYIEN=$PIECE(DATA0,U,6)
+64 SET CPYFIL=$PIECE(DATA0,U,7)
+65 IF CPYIEN>0
IF CPYFIL=""
SET CPYFIL=8925
+66 SET CAPP=$PIECE(DATA0,U,9)
+67 SET PRNTIEN=$PIECE(DATA0,U,11)
+68 IF PRNTIEN=""
IF $DATA(^TIUP(8928,"C",IEN))
SET PRNTIEN="+"
+69 SET FORCE=$PIECE(DATA0,U,12)
+70 SET CPYLOC=""
+71 SET CPYFILNM=""
+72 SET CPYFTXT=""
+73 IF CPYFIL'=""
Begin DoDot:3
+74 SET CPYFILNM=$$GET1^DIQ(1,CPYFIL_",",.01)
+75 SET CPYGBL=$$GET1^DIQ(1,CPYFIL_",",1)
+76 SET CPYGBLEN=CPYGBL_CPYIEN_")"
End DoDot:3
+77 IF CPYIEN=""
Begin DoDot:3
+78 SET CPYFTXT=$PIECE(DATA0,U,10)
+79 IF $PIECE(CPYFTXT," - ",1)="ORDER DETAILS"
Begin DoDot:4
+80 SET CPYIEN=$PIECE($PIECE(CPYFIL," - ",2),";",1)
+81 SET CPYFIL=100
End DoDot:4
End DoDot:3
+82 SET PCT=$PIECE(DATA0,U,8)
+83 SET CPYPTSRC=""
+84 SET CPYNAME=""
+85 SET CPYUSER=""
+86 SET CPYPTNAME=""
+87 SET CPYDUZ=""
+88 SET CPYUSER=""
+89 SET CPYDFN=""
+90 SET CPYSRCDT=""
+91 IF CPYFILNM="TIU DOCUMENT"
Begin DoDot:3
+92 ;REFERENCE DATE
SET CPYSRCDT=$PIECE($GET(^TIU(8925,CPYIEN,13)),U,1)
+93 ;AUTHOR/DICTATOR
SET CPYDUZ=$PIECE($GET(^TIU(CPYFIL,CPYIEN,12)),U,2)
+94 ;ENTERED BY
IF +CPYDUZ=0
SET CPYDUZ=$PIECE($GET(^TIU(CPYFIL,CPYIEN,13)),U,2)
+95 IF +CPYDUZ>0
SET CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
+96 IF CPYUSER=""
SET CPYUSER="UNKNOWN AUTHOR"
+97 SET CPYDATA0=$GET(^TIU(CPYFIL,CPYIEN,0))
+98 IF $GET(CPYDATA0)=""
QUIT
+99 SET CPYNAME=$PIECE(CPYDATA0,U,1)
+100 SET CPYNAME=$PIECE($GET(^TIU(8925.1,CPYNAME,0)),U,1)
+101 IF CPYNAME=""
SET CPYNAME="UNKNOWN NOTE TITLE"
+102 SET CPYDFN=$PIECE(CPYDATA0,U,2)
+103 IF +CPYDFN>0
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+104 IF CPYPTNAME=""
SET CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:3
+105 IF CPYFIL="100"
Begin DoDot:3
+106 SET CPYDATA0=$GET(^OR(CPYFIL,CPYIEN,0))
+107 IF $GET(CPYDATA0)=""
QUIT
+108 SET CPYSRCDT=$PIECE(CPYDATA0,U,7)
+109 ;WHO ENTERED
SET CPYDUZ=$PIECE(CPYDATA0,U,6)
+110 IF +CPYDUZ>0
SET CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
+111 IF CPYUSER=""
SET CPYUSER="UNKNOWN AUTHOR"
+112 SET CPYNAME="ORDER #"_$PIECE(CPYDATA0,U,1)
+113 IF +$PIECE(CPYNAME,"#",2)=0
SET CPYNAME="UNKNOWN ORDER NUMBER"
+114 ;ORDERABLE ITEMS (PATIENT/REFERRAL)
SET CPYDFN=$PIECE(CPYDATA0,U,2)
+115 IF +CPYDFN>0
Begin DoDot:4
+116 SET CPYGBL=$PIECE(CPYDFN,";",2)
+117 SET CPYDFN=+CPYDFN
End DoDot:4
+118 IF CPYGBL="DPT("
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+119 ;I CPYGBL="LRT(67," S CPYPTNAME=$P($G(^LRT(67,CPYDFN,0)),U,1),CPYPTSRC="R"
+120 IF CPYGBL="LRT(67,"
Begin DoDot:4
+121 SET CPYPTNAME=$$GET1^DIQ(67,CPYDFN_",",.01)
+122 SET CPYPTSRC="R"
End DoDot:4
+123 IF CPYPTNAME=""
SET CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:3
+124 IF CPYFILNM="REQUEST/CONSULTATION"
Begin DoDot:3
+125 SET CPYDATA0=$GET(^GMR(CPYFIL,CPYIEN,0))
+126 IF $GET(CPYDATA0)=""
QUIT
+127 SET CPYSRCDT=$PIECE(CPYDATA0,U,1)
+128 ;SENDING PROVIDER
SET CPYDUZ=$PIECE(CPYDATA0,U,14)
+129 IF +CPYDUZ>0
SET CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
+130 IF +CPYDUZ<1
IF $PIECE($GET(^GMR(CPYFIL,CPYIEN,12)),U,6)'=""
SET CPYUSER=$PIECE($GET(^GMR(CPYFIL,CPYIEN,12)),U,6)
SET CPYDUZ="IFC"
+131 IF CPYUSER=""
SET CPYUSER="UNKNOWN AUTHOR"
+132 SET CPYNAME="CONSULT #"_CPYIEN
+133 IF +$PIECE(CPYNAME,"#",2)=0
SET CPYNAME="UNKNOWN CONSULT NUMBER"
+134 ;PATIENT NAME (IEN)
SET CPYDFN=$PIECE(CPYDATA0,U,2)
+135 IF +CPYDFN>0
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+136 IF CPYPTNAME=""
SET CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:3
+137 IF $GET(CPYDATA0)=""
IF CPYFTXT=""
QUIT
+138 SET CPYLOC=$SELECT(CPYIEN'="":CPYIEN_";"_CPYFILNM,1:CPYFTXT)
+139 SET CNT=CNT+1
+140 SET ARY(CNT,0)=DTPST_U_$SELECT(+PSTDUZ>0:+PSTDUZ_";"_PSTUSER,1:"")_U_CPYLOC
+141 SET ARY(CNT,0)=$GET(ARY(CNT,0))_U_CPYNAME_U
+142 SET ARY(CNT,0)=$GET(ARY(CNT,0))_$SELECT(+CPYDUZ>0:+CPYDUZ_";"_CPYUSER,1:"")
+143 SET ARY(CNT,0)=$GET(ARY(CNT,0))_U_$SELECT(+CPYDFN>0:+CPYDFN_";"_CPYPTNAME,1:"")
+144 SET ARY(CNT,0)=$GET(ARY(CNT,0))_$SELECT(((CPYPTSRC="R")&(CPYPTSRC'="")):";"_CPYPTSRC,1:"")
+145 SET ARY(CNT,0)=$GET(ARY(CNT,0))_U_PCT_U_U_CAPP_U_CPYSRCDT_U_IEN_U_PRNTIEN_U_FORCE_U_TIUIEN
+146 IF +ZERO=1
QUIT
+147 SET LN=0
+148 SET X=""
+149 FOR
SET X=$ORDER(^TIUP(8928,IEN,1,X))
if X=""
QUIT
Begin DoDot:3
+150 IF X=0
SET LN=$PIECE($GET(^TIUP(8928,IEN,1,X)),U,4)
QUIT
+151 SET ARY(CNT,X)=$GET(^TIUP(8928,IEN,1,X,0))
End DoDot:3
+152 SET $PIECE(ARY(CNT,0),U,8)=LN
+153 SET LN=0
+154 SET X=""
+155 FOR
SET X=$ORDER(^TIUP(8928,IEN,2,X))
if X=""
QUIT
Begin DoDot:3
+156 IF X=0
SET LN=$PIECE($GET(^TIUP(8928,IEN,2,X)),U,4)
QUIT
+157 SET ARY(CNT,0,X)=$GET(^TIUP(8928,IEN,2,X,0))
End DoDot:3
+158 IF +LN>0
SET ARY(CNT,0,0)=LN
End DoDot:2
End DoDot:1
+159 SET ARY(0,0)=CNT
GETPSTQ IF TIUERR'=""
SET ARY(0,0)=TIUERR
+1 QUIT
+2 ;
CHKPASTE(TIUIEN,INST) ;Check pasted text exists for a document
+1 ; Call using $$CHKPASTE^TIUCOPP(DOCUMENT IDENTIFIER,INSTITUTION IEN)
+2 ;
+3 ; Input
+4 ; INST - Institution ien
+5 ; TIUIEN - Document ien and file # (ien;file), ien only is TIU note
+6 ;
+7 ; Output
+8 ; BOOLEAN - 1 Pasted Text Available
+9 ; 0 No Pasted Text
+10 ;
+11 NEW DTPST,ERR,FILE,FILENM,IEN,RSLT,TIUIENLN
+12 SET RSLT=0
+13 IF $GET(INST)=""
SET INST=$GET(DUZ(2))
+14 IF +INST<1
QUIT RSLT
+15 SET INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
+16 IF +INST<1
QUIT RSLT
+17 IF $GET(TIUIEN)=""
QUIT RSLT
+18 SET TIUIENLN=$LENGTH(TIUIEN,";")
+19 SET FILE=$SELECT(TIUIENLN>1:$PIECE($GET(TIUIEN),";",2),1:"8925")
+20 SET TIUIEN=$PIECE($GET(TIUIEN),";",1)
+21 IF FILE=""!(FILE="TIU")
SET FILE="8925"
+22 IF TIUIEN=""
QUIT RSLT
+23 IF '$$GDFIL^TIUCOPUT(TIUIEN,.FILE,.FILENM)
QUIT RSLT
+24 SET DTPST=""
+25 FOR
SET DTPST=$ORDER(^TIUP(8928,"AC",TIUIEN,FILE,DTPST))
if DTPST=""
QUIT
Begin DoDot:1
+26 SET IEN=""
+27 FOR
SET IEN=$ORDER(^TIUP(8928,"AC",TIUIEN,FILE,DTPST,IEN))
if IEN=""
QUIT
Begin DoDot:2
+28 IF $GET(^TIUP(8928,IEN,0))=""
QUIT
+29 SET RSLT=1
QUIT
End DoDot:2
if RSLT
QUIT
End DoDot:1
if RSLT
QUIT
+30 QUIT RSLT
