Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUCOPP

TIUCOPP.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; External Reference
  1. ; DBIA 10000 NOW^%DTC
  1. ; DBIA 2051 $$FIND1^DIC
  1. ; DBIA 2058 ^DIC(9.4
  1. ; DBIA 2053 UPDATE^DIE
  1. ; DBIA 10018 ^DIE
  1. ; DBIA 10060 ^VA(200,
  1. ; DBIA 2056 $$GET1^DIQ
  1. ; DBIA 10090 ^DIC(4
  1. ; DBIA 10035 ^DPT(
  1. ; DBIA 5771 ^OR(100
  1. ; DBIA 3260 ^LRT(67
  1. ; DBIA 3162 ^GMR(123 0;14 12;6
  1. ; DBIA 10103 NOW^XLFDT
  1. ; DBIA 10063 ^%ZTLOAD
  1. ; DBIA 10063 STAT^%ZTLOAD
  1. ;
  1. PUTPASTE(INST,ARY,ERR,SVARY) ;Save Pasted Text
  1. ; Call using $$PUTPASTE^TIUCOPP(INST,.ARY,.ERR)
  1. ;
  1. ; Input
  1. ; INST - Institution ien (file #4)
  1. ; ARY - Array containing data to be saved into the Pasted Text file
  1. ; Components of ARY:
  1. ; ARY(1,0)=
  1. ; Piece 1: Input User DUZ
  1. ; Piece 2: Paste date/time (Fileman format "YYYMMDD.HHMMSS")
  1. ; Piece 3: Pasted to location (IEN;Package)
  1. ; GMRC = Consults (#123)
  1. ; TIU = Text Integration Utilities (#8925)
  1. ; OR = CPRS (#100)
  1. ; ??? = Other packages to be determined
  1. ; If only IEN is received (single data piece),
  1. ; will assume TIU Note IEN by default
  1. ; Piece 4: Copy from IEN;Package (1230;GMRC)
  1. ; GMRC = Consults (#123)
  1. ; TIU = Text Integration Utilities (#8925)
  1. ; OR = CPRS (#100)
  1. ; OUT = Outside of application
  1. ; ??? = Other packages to be determined
  1. ; -1 for an IEN will indicate free text value in second piece
  1. ; Piece 5: Percent match between copied text and pasted text
  1. ; Piece 6: Capturing application
  1. ; Piece 7: Edited Note IEN (Only if contains previous pasted text.
  1. ; Send -1 otherwise.)
  1. ; Piece 8: Force App to run find
  1. ; Piece 9: Not passed in, but is used to indicate parent when found
  1. ; pasted text is part of an entry
  1. ; ARY(1,0,1)= Copied text (Only if Pasted text is not 100% match)
  1. ; ARY(1,0,2)= Copied text
  1. ; ARY(1,0,n)= Copied text
  1. ; ARY(1,1)= Pasted text
  1. ; ARY(1,2)= Pasted text
  1. ; ARY(1,n)= Pasted text
  1. ; ARY(1,"PASTE",1,1)= Found Pasted text chunk 1
  1. ; ARY(1,"PASTE",1,2)= Found Pasted text chunk 1
  1. ; ARY(1,"PASTE",1,n)= Found Pasted text chunk 1
  1. ; ARY(1,"PASTE",2,1)= Found Pasted text chunk 2
  1. ; ARY(1,"PASTE",2,2)= Found Pasted text chunk 2
  1. ; ARY(1,"PASTE",2,n)= Found Pasted text chunk 2
  1. ; ARY(1,"PASTE",n,n)= Found Pasted text chunk 3...n
  1. ; ARY(2,0)= Next record (Same format as ARY(1,0))
  1. ; ARY(2,0,1)= Copied text
  1. ; ARY(2,1)= Pasted text
  1. ; ARY(2,"PASTE",1,1)= Found Pasted text
  1. ; ARY(N,n)
  1. ;
  1. ; ERR - Name of array to return error message in.
  1. ; SVARY - Array to receive saved paste info
  1. ;
  1. ; Output
  1. ; Boolean (1: Success, 0: Failed)
  1. ; ERR("ERR") - "-1^Error Message"
  1. ; Returned in variable received. If ERR variable not received,
  1. ; then TIUERR variable will be set and returned with the
  1. ; error message. If TIUERR is returned, calling routine will
  1. ; need to handle it properly.
  1. ; SVARY - Array returned containing ien of saved data
  1. ;
  1. N %,%H,%I,CDTM,DATA,DAYS,DFN,TIUCNT,TIUCPDT,TMPARY,CPIEN,CPFIL,PRFX,SAVE
  1. N TIUACNT,TIUNMSPC,TODATE,TXT,X,X1,X2,TIUCPRCD,TIULN,TIULNG,TXTDATA,PSV
  1. N TIUPSTDT,PSTIEN,PSTFIL,CPLOC,FDA,FDAIEN,CDT,DATA0,DIERR,PCT,TIUERR
  1. N TFSCNT,CPFTXT,PSTPCT,PARENT,PRNTARY,PSTFILNM,PSTFILGB,CPFILNM,SPST
  1. N CAPP,PSTXTIEN,PSTLNG,NOFIND,PSTCALC,PRNTFND,PSTPCT,SMPST,C,Y
  1. N CRGLN,FORCE
  1. S SVARY=+$G(SVARY)
  1. I SVARY<1 S SVARY=0
  1. S PSTCALC=""
  1. S PSTPCT=""
  1. S TFSCNT=0
  1. S TIUERR=""
  1. S (PRNTARY,TMPARY)=""
  1. S CRGLN="#13#10"
  1. S SAVE=0
  1. D NOW^%DTC
  1. S CDTM=%
  1. S CDT=X
  1. I $G(INST)="" S INST=$G(DUZ(2))
  1. I +INST<1 S TIUERR="-1^Invalid institution" G SVPSTQ
  1. S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
  1. I +INST<1 S TIUERR="-1^Invalid institution" G SVPSTQ
  1. I '$D(ARY) S TIUERR="-1^Input array does not exist." G SVPSTQ
  1. I $G(ARY(1,0))="" S TIUERR="-1^Zero node of received array is empty." G SVPSTQ
  1. S SPST=$$PCT^TIUCOP(INST)*100
  1. S TIUCPRCD=""
  1. F S TIUCPRCD=$O(ARY(TIUCPRCD)) Q:TIUCPRCD="" D Q:+TIUERR=-1
  1. . S DATA0=$G(ARY(TIUCPRCD,0))
  1. . S PSTXTIEN=$P(DATA0,U,7)
  1. . I $P($G(PSTXTIEN),"~",1)="NOCALC" D
  1. .. S PSTCALC="NOCALC"
  1. .. S PSTPCT=+$P($G(PSTXTIEN),"~",2)
  1. .. S PSTXTIEN=0
  1. . S PRNTFND=1
  1. . I +PSTXTIEN>0 S PRNTFND=$$PRNTFND(.PSTXTIEN,TIUCPRCD,.ARY)
  1. . Q:PRNTFND=0
  1. . S DFN=$P(DATA0,U,1) I DFN="" S DFN=DUZ ;S TIUERR="-1^User dfn is required." Q
  1. . I $$DFNCHK^TIUCOPUT(DFN)=0 S TIUERR="-1^User ien is not valid." Q
  1. . S TIUPSTDT=$P(DATA0,U,2) I TIUPSTDT="" S TIUERR="-1^Paste date/time is required." Q
  1. . I $$DTCHK^TIUCOPUT(TIUPSTDT)=0 S TIUERR="-1^Paste date is not valid." Q
  1. . D UNQDT^TIUCOPUT(.TIUPSTDT)
  1. . S PSTIEN=$P($P(DATA0,U,3),";",1)
  1. . I PSTIEN="" S TIUERR="-1^Pasted to IEN is required." Q
  1. . S PSTFILNM=""
  1. . S PSTFIL=$P($P(DATA0,U,3),";",2) I PSTFIL=""!(PSTFIL="TIU") S PSTFIL="8925"
  1. . I '$$GDFIL^TIUCOPUT(PSTIEN,.PSTFIL,.PSTFILNM) S TIUERR="-1^Pasted to file/ien is not valid." Q
  1. . S CPFTXT=""
  1. . S CPLOC=$P(DATA0,U,4) I CPLOC'="" D
  1. .. S CPIEN=$P(CPLOC,";",1)
  1. .. S CPFIL=$P(CPLOC,";",2,99)
  1. .. S CPFIL=$S(CPFIL="GMRC":123,CPFIL="OR":100,CPFIL="TIU":8925,CPFIL="":8925,1:CPFIL)
  1. .. S CPFILNM=""
  1. .. I CPIEN=-1 S CPFTXT=CPFIL,CPFIL=""
  1. .. I CPIEN=-1,CPFTXT="" S CPFTXT="Outside of current CPRS tracking"
  1. . I CPFIL'="",'$$GDFIL^TIUCOPUT(CPIEN,.CPFIL,.CPFILNM) S TIUERR="-1^Copy from package/ien is not valid." Q
  1. . I CPIEN=-1,CPFTXT="" S TIUERR="-1^Copy from free text identifier is empty." Q
  1. . S CAPP=$P(DATA0,U,6) I $L(CAPP)>15 S CAPP=$E(CAPP,1,15)
  1. . S PCT=+$P(DATA0,U,5) I PCT>100 S PCT=100
  1. . S (X,TXT)=0
  1. . F S X=$O(ARY(TIUCPRCD,X)) Q:+X=0 D Q:TXT=1 ;Remove leading blank lines
  1. .. I $TR($G(ARY(TIUCPRCD,X))," ")]"" S TXT=1 Q
  1. .. K ARY(TIUCPRCD,X)
  1. . S TXT=0
  1. . S X=999999999
  1. . F S X=$O(ARY(TIUCPRCD,X),-1) Q:+X=0 D Q:TXT=1 ;Remove trailing blank lines
  1. .. I $TR($G(ARY(TIUCPRCD,X))," ")]"" S TXT=1 Q
  1. .. K ARY(TIUCPRCD,X)
  1. . I +PSTXTIEN=-1,TXT=0 S TIUERR="-1^Pasted text contains no text" Q
  1. . S X=0,PSTLNG=0,NOFIND=0
  1. . S (TXT,TIUACNT,TIUCNT)=0
  1. . F S X=$O(ARY(TIUCPRCD,X)) Q:+X=0 D
  1. .. S TIUACNT=TIUACNT+1
  1. .. S TIULNG=$L($G(ARY(TIUCPRCD,X)),"#13#10")
  1. .. I TIULNG>1 D
  1. ... S TXTDATA=$G(ARY(TIUCPRCD,X))
  1. ... F TIULN=1:1:TIULNG D
  1. .... S TIUCNT=TIUCNT+1
  1. .... S TMPARY(TIUCNT)=$P(TXTDATA,"#13#10",TIULN)
  1. .. I TIULNG=1 S TIUCNT=TIUCNT+1 S TMPARY(TIUCNT)=$G(ARY(TIUCPRCD,X))
  1. . I TIUCNT>TIUACNT D
  1. .. S TIULN=""
  1. .. F S TIULN=$O(TMPARY(TIULN)) Q:TIULN="" D
  1. ... S ARY(TIUCPRCD,TIULN)=$G(TMPARY(TIULN))
  1. . S FORCE=+$P(DATA0,U,8)
  1. . I FORCE>2 S FORCE=0
  1. . I FORCE<0 S FORCE=0
  1. . S PARENT=+$P(DATA0,U,9)
  1. . I PARENT=0 D RBLDARY^TIUCOPUT(.ARY,TIUCPRCD,CRGLN,PCT)
  1. . S SMPST=0
  1. . K C
  1. . S C=""
  1. . I +PSTXTIEN<1,PARENT=0 D
  1. .. S SMPST=$$CPYTXT^TIUCOPUT(.ARY,TIUCPRCD,.C)
  1. . D SVPST
  1. I SVARY>0 S SVARY(0)=TFSCNT
  1. I '$D(DIERR),$G(TIUERR)="" S SAVE=1
  1. I $D(DIERR) D
  1. . N ERRNM,ERRCNT,ERRTXT,LP
  1. . S ERRTXT=""
  1. . S TIUERR="-1^Error saving pasted text"
  1. . S ERRNM=$P(DIERR,U,1)
  1. . F ERRCNT=1:1:ERRNM D
  1. .. S LP=0
  1. .. F S LP=$O(^TMP("DIERR",$J,ERRCNT,"TEXT",LP)) Q:LP="" S ERRTXT=ERRTXT_$G(^TMP("DIERR",$J,ERRCNT,"TEXT",LP))
  1. .. S TIUERR(ERRCNT)=$G(^TMP("DIERR",$J,ERRCNT))_"^"_ERRTXT
  1. SVPSTQ I $G(TIUERR)'="" D
  1. . S ERR("ERR")=$G(TIUERR)
  1. . S X=""
  1. . F S X=$O(TIUERR(X)) Q:X="" D
  1. .. S ERR("ERR",X)=$G(TIUERR(X))
  1. . K TIUERR
  1. K ^TMP("DIERR",$J)
  1. Q SAVE
  1. ;
  1. PRNTFND(PSTXTIEN,TIUCPRCD,ARY) ;
  1. N FND,CHLD,PRNT,STRLNG,X
  1. S FND=0
  1. I '$D(^TIUP(8928,PSTXTIEN,0)) D Q:FND=0 0
  1. . S PRNT=""
  1. . F S PRNT=$O(^TIUP(8928,"C",PRNT)) Q:PRNT="" D Q:FND=1
  1. .. I '$D(^TIUP(8928,"C",PRNT,PSTXTIEN)) Q
  1. .. S PSTXTIEN=PRNT
  1. .. S FND=1
  1. I $D(^TIUP(8928,"C",PSTXTIEN)) D Q 1
  1. . D KLLCHLD(PSTXTIEN)
  1. S PRNT=$P(^TIUP(8928,PSTXTIEN,0),U,11)
  1. I +PRNT>0,$D(^TIUP(8928,PRNT,0)),$D(^TIUP(8928,PRNT,1)) D
  1. . S PSTXTIEN=PRNT
  1. . S FND=1
  1. ;I $D(^TIUP(8928,PSTXTIEN,1)) D
  1. ;. S X=0
  1. ;. F S X=$O(ARY(TIUCPRCD,X)) Q:+X=0 K ARY(TIUCPRCD,X)
  1. ;. S X=0
  1. ;. F S X=$O(^TIUP(8928,PSTXTIEN,1,X)) Q:X="" D
  1. ;.. S ARY(TIUCPRCD,X)=$G(^TIUP(8928,PSTXTIEN,1,X,0))
  1. I '$G(ARY(TIUCPRCD,0,1)),$D(^TIUP(8928,PSTXTIEN,2)) D
  1. . S X=0
  1. . F S X=$O(^TIUP(8928,PSTXTIEN,2,X)) Q:X="" D
  1. .. S ARY(TIUCPRCD,0,X)=$G(^TIUP(8928,PSTXTIEN,1,X,0))
  1. D KLLCHLD(PSTXTIEN)
  1. Q 1
  1. ;
  1. KLLCHLD(PRNT) ;Kill off child paste entries
  1. N DA,DIK
  1. S DIK="^TIUP(8928,"
  1. S DA=""
  1. F S DA=$O(^TIUP(8928,"C",PRNT,DA)) Q:DA="" D ^DIK
  1. Q
  1. ;
  1. SVPST ;Save the paste information
  1. ;The following variables are expected to exist and are created
  1. ; in PUTPASTE^TIUCOPP which calls this code:
  1. ; CAPP,CPFIL,CPFTXT,CPIEN,DFN,FORCE,INST,PARENT,PCT,PRNTARY
  1. ; PSTFIL,PSTIEN,PSTXTIEN,SMPST,SVARY,TFSCNT,TIUCPRCD,TIUPSTDT
  1. N DA,FDA,FDAIEN
  1. S DA=""
  1. S PRNTARY(TIUCPRCD)=$S(PARENT>0:PARENT,1:0)
  1. I +PSTXTIEN>0 S FDAIEN(TIUCPRCD)=PSTXTIEN
  1. I +PSTXTIEN'>0 D
  1. . S FDA(8928,"+"_TIUCPRCD_",",.01)=TIUPSTDT
  1. . S FDA(8928,"+"_TIUCPRCD_",",.02)=DFN
  1. . S FDA(8928,"+"_TIUCPRCD_",",.03)=INST
  1. . S FDA(8928,"+"_TIUCPRCD_",",.04)=PSTIEN
  1. . S FDA(8928,"+"_TIUCPRCD_",",.05)=PSTFIL
  1. . S FDA(8928,"+"_TIUCPRCD_",",.06)=$S(CPIEN=-1:"",1:CPIEN)
  1. . S FDA(8928,"+"_TIUCPRCD_",",.07)=$S(CPIEN=-1:"",1:CPFIL)
  1. . S FDA(8928,"+"_TIUCPRCD_",",.08)=$S(PCT=0:100,1:PCT) ;PCT
  1. . S FDA(8928,"+"_TIUCPRCD_",",.09)=CAPP
  1. . S FDA(8928,"+"_TIUCPRCD_",",.1)=$S(CPIEN=-1:CPIEN_";"_CPFTXT,1:"")
  1. . S FDA(8928,"+"_TIUCPRCD_",",.12)=FORCE
  1. . S FDA(8928,"+"_TIUCPRCD_",",1)="ARY("_TIUCPRCD_")"
  1. . I $G(SMPST)=1 S FDA(8928,"+"_TIUCPRCD_",",2)="C"
  1. . D UPDATE^DIE("","FDA","FDAIEN","")
  1. . S DA=$G(FDAIEN(TIUCPRCD))
  1. I +PSTXTIEN>0 D
  1. . N SVPCT
  1. . K FDA
  1. . I '$D(^TIUP(8928,PSTXTIEN)) Q
  1. . S SVPCT=$S(PCT=0:100,1:PCT)
  1. . S FDA(8928,PSTXTIEN_",",.08)=SVPCT
  1. . S FDA(8928,PSTXTIEN_",",.12)=FORCE
  1. . D FILE^DIE("","FDA","")
  1. I +PSTXTIEN>0,DA="" S DA=PSTXTIEN
  1. I SVARY>0,+PARENT=0 D
  1. . S SVARY(TIUCPRCD)=INST_U_DA
  1. . S TFSCNT=TFSCNT+1
  1. S PRNTARY(TIUCPRCD,0)=DA
  1. I +PARENT>0,+DA>0 D
  1. . N DIE,DR,NODE,PARENTDA
  1. . S NODE=$G(PRNTARY(PARENT,0))
  1. . S PARENTDA=$P(NODE,U,1)
  1. . S DIE="^TIUP(8928,"
  1. . S DR=".11///^S X=PARENTDA"
  1. . D ^DIE
  1. Q
  1. ;
  1. GETPASTE(TIUIEN,INST,APP,ARY,ZERO) ;Retrieve pasted text
  1. ; Call using GETPASTE^TIUCOPP(NOTE IEN,INSTITUTION IEN,CALLING APPLICATION,.RETURN ARRAY)
  1. ;
  1. ; Input
  1. ; INST - Institution ien
  1. ; TIUIEN - Document ien and package (ien;file), ien only is TIU note
  1. ; APP - Application retrieving pasted text (Not used)
  1. ; ARY - Array to return the pasted text data
  1. ; ZERO - 1 = Return zero node only
  1. ;
  1. ; Output
  1. ; ARY(0,0) - Total number of unique entries
  1. ; Or
  1. ; Error condition "-1^Error Msg"
  1. ;
  1. ; ARY(1..n,0) - (If ZERO = 1, then only node returned)
  1. ; Piece 1: Date/Time of the paste
  1. ; Piece 2: User who pasted text
  1. ; Piece 3: Copy from location (ien;file)
  1. ; Piece 4: Copy from document title
  1. ; Piece 5: Copy from document author (duz;name(last,first m))
  1. ; Piece 6: Copy from Patient (dfn;name(last,first m))
  1. ; Piece 7: Percent match between copied text and pasted text
  1. ; Piece 8: Number of lines of pasted text
  1. ; Piece 9: Capturing Application
  1. ; Piece 10: Date/Time of the copy from document
  1. ; Piece 11: Saved Paste IEN
  1. ; Piece 12: Parent IEN
  1. ; Piece 13: Force Search
  1. ; (2=No Search,1=Yes,0=No)
  1. ; Piece 14: Pasted Note (#8925) IEN
  1. ; ARY(1,0,0) - Copy text line count
  1. ; ARY(1..n,0,1..n) - Copied text
  1. ; ARY(1..n,1..n) - Pasted text
  1. ;
  1. N CNT,CPYDATA0,CPYDFN,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYFIL,CPYPTNAME
  1. N CPYPTSRC,CPYUSER,DATA0,DTPST,IEN,LN,PCT,FILE,PRFX,PSTDUZ,PSTUSER
  1. N TIUERR,TIUIENLN,TIUNMSPC,X,NODISP,CPYFILNM,CPYGBLEN,FILENM,CPYFTXT
  1. N CPYLOC,CAPP,CPYSRCDT,PRNTIEN,TEXTLNG,COMPLT,FORCE
  1. S TIUERR=""
  1. I $G(ARY)'["" S TIUERR="-1^Return array is required." G GETPSTQ
  1. I $G(INST)="" S INST=$G(DUZ(2))
  1. I +INST<1 S TIUERR="-1^Invalid institution" G GETPSTQ
  1. S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
  1. I +INST<1 S TIUERR="-1^Invalid institution" G GETPSTQ
  1. I $G(TIUIEN)="" S TIUERR="-1^Document ien is required." G GETPSTQ
  1. S TIUIENLN=$L(TIUIEN,";")
  1. S FILE=$S(TIUIENLN>1:$P($G(TIUIEN),";",2),1:"8925")
  1. S TIUIEN=$P($G(TIUIEN),";",1)
  1. I FILE=""!(FILE="TIU") S FILE="8925"
  1. I TIUIEN="" S TIUERR="-1^Document IEN is required." G GETPSTQ
  1. I '$$GDFIL^TIUCOPUT(TIUIEN,.FILE,.FILENM) S TIUERR="-1^Document file/ien is not valid." G GETPSTQ
  1. S CNT=$S(+$G(ARY(0,0))'<0:+$G(ARY(0,0)),1:0)
  1. S DTPST=""
  1. F S DTPST=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST)) Q:DTPST="" D
  1. . S IEN=""
  1. . F S IEN=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST,IEN)) Q:IEN="" D
  1. .. S CPYDATA0=""
  1. .. S DATA0=$G(^TIUP(8928,IEN,0))
  1. .. I DATA0="" Q
  1. .. S PSTDUZ=$P(DATA0,U,2)
  1. .. I +PSTDUZ>0 S PSTUSER=$$GET1^DIQ(200,PSTDUZ_",",.01)
  1. .. I PSTUSER="" S PSTUSER="UNKNOWN PASTER NAME"
  1. .. S CPYIEN=$P(DATA0,U,6)
  1. .. S CPYFIL=$P(DATA0,U,7)
  1. .. I CPYIEN>0,CPYFIL="" S CPYFIL=8925
  1. .. S CAPP=$P(DATA0,U,9)
  1. .. S PRNTIEN=$P(DATA0,U,11)
  1. .. I PRNTIEN="",$D(^TIUP(8928,"C",IEN)) S PRNTIEN="+"
  1. .. S FORCE=$P(DATA0,U,12)
  1. .. S CPYLOC=""
  1. .. S CPYFILNM=""
  1. .. S CPYFTXT=""
  1. .. I CPYFIL'="" D
  1. ... S CPYFILNM=$$GET1^DIQ(1,CPYFIL_",",.01)
  1. ... S CPYGBL=$$GET1^DIQ(1,CPYFIL_",",1)
  1. ... S CPYGBLEN=CPYGBL_CPYIEN_")"
  1. .. I CPYIEN="" D
  1. ... S CPYFTXT=$P(DATA0,U,10)
  1. ... I $P(CPYFTXT," - ",1)="ORDER DETAILS" D
  1. .... S CPYIEN=$P($P(CPYFIL," - ",2),";",1)
  1. .... S CPYFIL=100
  1. .. S PCT=$P(DATA0,U,8)
  1. .. S CPYPTSRC=""
  1. .. S CPYNAME=""
  1. .. S CPYUSER=""
  1. .. S CPYPTNAME=""
  1. .. S CPYDUZ=""
  1. .. S CPYUSER=""
  1. .. S CPYDFN=""
  1. .. S CPYSRCDT=""
  1. .. I CPYFILNM="TIU DOCUMENT" D
  1. ... S CPYSRCDT=$P($G(^TIU(8925,CPYIEN,13)),U,1) ;REFERENCE DATE
  1. ... S CPYDUZ=$P($G(^TIU(CPYFIL,CPYIEN,12)),U,2) ;AUTHOR/DICTATOR
  1. ... I +CPYDUZ=0 S CPYDUZ=$P($G(^TIU(CPYFIL,CPYIEN,13)),U,2) ;ENTERED BY
  1. ... I +CPYDUZ>0 S CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
  1. ... I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
  1. ... S CPYDATA0=$G(^TIU(CPYFIL,CPYIEN,0))
  1. ... I $G(CPYDATA0)="" Q
  1. ... S CPYNAME=$P(CPYDATA0,U,1)
  1. ... S CPYNAME=$P($G(^TIU(8925.1,CPYNAME,0)),U,1)
  1. ... I CPYNAME="" S CPYNAME="UNKNOWN NOTE TITLE"
  1. ... S CPYDFN=$P(CPYDATA0,U,2)
  1. ... I +CPYDFN>0 S CPYPTNAME=$P($G(^DPT(CPYDFN,0)),U,1)
  1. ... I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
  1. .. I CPYFIL="100" D
  1. ... S CPYDATA0=$G(^OR(CPYFIL,CPYIEN,0))
  1. ... I $G(CPYDATA0)="" Q
  1. ... S CPYSRCDT=$P(CPYDATA0,U,7)
  1. ... S CPYDUZ=$P(CPYDATA0,U,6) ;WHO ENTERED
  1. ... I +CPYDUZ>0 S CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
  1. ... I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
  1. ... S CPYNAME="ORDER #"_$P(CPYDATA0,U,1)
  1. ... I +$P(CPYNAME,"#",2)=0 S CPYNAME="UNKNOWN ORDER NUMBER"
  1. ... S CPYDFN=$P(CPYDATA0,U,2) ;ORDERABLE ITEMS (PATIENT/REFERRAL)
  1. ... I +CPYDFN>0 D
  1. .... S CPYGBL=$P(CPYDFN,";",2)
  1. .... S CPYDFN=+CPYDFN
  1. ... I CPYGBL="DPT(" S CPYPTNAME=$P($G(^DPT(CPYDFN,0)),U,1)
  1. ... ;I CPYGBL="LRT(67," S CPYPTNAME=$P($G(^LRT(67,CPYDFN,0)),U,1),CPYPTSRC="R"
  1. ... I CPYGBL="LRT(67," D
  1. .... S CPYPTNAME=$$GET1^DIQ(67,CPYDFN_",",.01)
  1. .... S CPYPTSRC="R"
  1. ... I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
  1. .. I CPYFILNM="REQUEST/CONSULTATION" D
  1. ... S CPYDATA0=$G(^GMR(CPYFIL,CPYIEN,0))
  1. ... I $G(CPYDATA0)="" Q
  1. ... S CPYSRCDT=$P(CPYDATA0,U,1)
  1. ... S CPYDUZ=$P(CPYDATA0,U,14) ;SENDING PROVIDER
  1. ... I +CPYDUZ>0 S CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
  1. ... I +CPYDUZ<1,$P($G(^GMR(CPYFIL,CPYIEN,12)),U,6)'="" S CPYUSER=$P($G(^GMR(CPYFIL,CPYIEN,12)),U,6),CPYDUZ="IFC"
  1. ... I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
  1. ... S CPYNAME="CONSULT #"_CPYIEN
  1. ... I +$P(CPYNAME,"#",2)=0 S CPYNAME="UNKNOWN CONSULT NUMBER"
  1. ... S CPYDFN=$P(CPYDATA0,U,2) ;PATIENT NAME (IEN)
  1. ... I +CPYDFN>0 S CPYPTNAME=$P($G(^DPT(CPYDFN,0)),U,1)
  1. ... I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
  1. .. I $G(CPYDATA0)="",CPYFTXT="" Q
  1. .. S CPYLOC=$S(CPYIEN'="":CPYIEN_";"_CPYFILNM,1:CPYFTXT)
  1. .. S CNT=CNT+1
  1. .. S ARY(CNT,0)=DTPST_U_$S(+PSTDUZ>0:+PSTDUZ_";"_PSTUSER,1:"")_U_CPYLOC
  1. .. S ARY(CNT,0)=$G(ARY(CNT,0))_U_CPYNAME_U
  1. .. S ARY(CNT,0)=$G(ARY(CNT,0))_$S(+CPYDUZ>0:+CPYDUZ_";"_CPYUSER,1:"")
  1. .. S ARY(CNT,0)=$G(ARY(CNT,0))_U_$S(+CPYDFN>0:+CPYDFN_";"_CPYPTNAME,1:"")
  1. .. S ARY(CNT,0)=$G(ARY(CNT,0))_$S(((CPYPTSRC="R")&(CPYPTSRC'="")):";"_CPYPTSRC,1:"")
  1. .. S ARY(CNT,0)=$G(ARY(CNT,0))_U_PCT_U_U_CAPP_U_CPYSRCDT_U_IEN_U_PRNTIEN_U_FORCE_U_TIUIEN
  1. .. IF +ZERO=1 Q
  1. .. S LN=0
  1. .. S X=""
  1. .. F S X=$O(^TIUP(8928,IEN,1,X)) Q:X="" D
  1. ... I X=0 S LN=$P($G(^TIUP(8928,IEN,1,X)),U,4) Q
  1. ... S ARY(CNT,X)=$G(^TIUP(8928,IEN,1,X,0))
  1. .. S $P(ARY(CNT,0),U,8)=LN
  1. .. S LN=0
  1. .. S X=""
  1. .. F S X=$O(^TIUP(8928,IEN,2,X)) Q:X="" D
  1. ... I X=0 S LN=$P($G(^TIUP(8928,IEN,2,X)),U,4) Q
  1. ... S ARY(CNT,0,X)=$G(^TIUP(8928,IEN,2,X,0))
  1. .. I +LN>0 S ARY(CNT,0,0)=LN
  1. S ARY(0,0)=CNT
  1. GETPSTQ I TIUERR'="" S ARY(0,0)=TIUERR
  1. Q
  1. ;
  1. CHKPASTE(TIUIEN,INST) ;Check pasted text exists for a document
  1. ; Call using $$CHKPASTE^TIUCOPP(DOCUMENT IDENTIFIER,INSTITUTION IEN)
  1. ;
  1. ; Input
  1. ; INST - Institution ien
  1. ; TIUIEN - Document ien and file # (ien;file), ien only is TIU note
  1. ;
  1. ; Output
  1. ; BOOLEAN - 1 Pasted Text Available
  1. ; 0 No Pasted Text
  1. ;
  1. N DTPST,ERR,FILE,FILENM,IEN,RSLT,TIUIENLN
  1. S RSLT=0
  1. I $G(INST)="" S INST=$G(DUZ(2))
  1. I +INST<1 Q RSLT
  1. S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
  1. I +INST<1 Q RSLT
  1. I $G(TIUIEN)="" Q RSLT
  1. S TIUIENLN=$L(TIUIEN,";")
  1. S FILE=$S(TIUIENLN>1:$P($G(TIUIEN),";",2),1:"8925")
  1. S TIUIEN=$P($G(TIUIEN),";",1)
  1. I FILE=""!(FILE="TIU") S FILE="8925"
  1. I TIUIEN="" Q RSLT
  1. I '$$GDFIL^TIUCOPUT(TIUIEN,.FILE,.FILENM) Q RSLT
  1. S DTPST=""
  1. F S DTPST=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST)) Q:DTPST="" D Q:RSLT
  1. . S IEN=""
  1. . F S IEN=$O(^TIUP(8928,"AC",TIUIEN,FILE,DTPST,IEN)) Q:IEN="" D Q:RSLT
  1. .. I $G(^TIUP(8928,IEN,0))="" Q
  1. .. S RSLT=1 Q
  1. Q RSLT