- 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 Feb 19, 2025@00:05:51 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