TIUCOP1 ;SLC/TDP - Copy/Paste Paste Tracking ;03/23/16 14:53
;;1.0;TEXT INTEGRATION UTILITIES;**290**;Jun 20, 1997;Build 548
;
Q
GETPST(PIEN,INST,ARY,ZERO) ;Retrieve pasted text for a specific pasted text entry
; Call using GETPST^TIUCOP(PASTED TEXT IEN,INSTITUTION IEN,.RETURN ARRAY)
;
; Input
; INST - Institution ien
; PIEN - Pasted text ien
; 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
; 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,PIENLN,TIUNMSPC,X,NODISP,CPYFILNM,CPYGBLEN,FILENM,CPYFTXT
N CPYLOC,CAPP,CPYSRCDT,PRNTIEN,TEXTLNG,X,LP
S TIUERR=""
I $G(ARY)'["" S TIUERR="-1^Return array is required." G GTPSTQ
I $G(INST)="" S TIUERR="-1^Institution is required" G GTPSTQ
I +INST<1 S TIUERR="-1^Invalid institution" G GTPSTQ
S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
I +INST<1 S TIUERR="-1^Invalid institution" G GTPSTQ
I +$G(PIEN)=0 S TIUERR="-1^Pasted text ien is required." G GTPSTQ
S CNT=$S(+$G(ARY(0,0))'<0:+$G(ARY(0,0)),1:0)
S IEN=PIEN
;S X=""
;F S X=$O(^TIUP(8928,"C",PIEN,X)) Q:X="" D
;. S IEN=$G(IEN)_U_X
;F LP=1:1:$L(IEN,U) D
;. S PIEN=$P(IEN,U,LP)
S DATA0=$G(^TIUP(8928,PIEN,0))
I DATA0="" Q
S PSTUSER=""
S DTPST=$P(DATA0,U,1)
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)
S CAPP=$P(DATA0,U,9)
S PRNTIEN=$P(DATA0,U,11)
I PRNTIEN="",$D(^TIUP(8928,"C",PIEN)) S PRNTIEN="+"
;S COMPLT=$P(DATA0,U,14)
;I COMPLT=0 Q
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 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_PIEN_U_PRNTIEN
S ARY(0,0)=CNT
I TIUERR'="" S ARY(0,0)=TIUERR
IF +ZERO=1 Q
S LN=0
S X=""
F S X=$O(^TIUP(8928,PIEN,1,X)) Q:X="" D
. I X=0 S LN=$P($G(^TIUP(8928,PIEN,1,X)),U,4) Q
. S ARY(CNT,X)=$G(^TIUP(8928,PIEN,1,X,0))
S $P(ARY(CNT,0),U,8)=LN
S LN=0
S X=""
F S X=$O(^TIUP(8928,PIEN,2,X)) Q:X="" D
. I X=0 S LN=$P($G(^TIUP(8928,PIEN,2,X)),U,4) Q
. S ARY(CNT,0,X)=$G(^TIUP(8928,PIEN,2,X,0))
I +LN>0 S ARY(CNT,0,0)=LN
S ARY(0,0)=CNT
GTPSTQ I TIUERR'="" S ARY(0,0)=TIUERR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCOP1 6116 printed Nov 22, 2024@17:49:18 Page 2
TIUCOP1 ;SLC/TDP - Copy/Paste Paste Tracking ;03/23/16 14:53
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**290**;Jun 20, 1997;Build 548
+2 ;
+3 QUIT
GETPST(PIEN,INST,ARY,ZERO) ;Retrieve pasted text for a specific pasted text entry
+1 ; Call using GETPST^TIUCOP(PASTED TEXT IEN,INSTITUTION IEN,.RETURN ARRAY)
+2 ;
+3 ; Input
+4 ; INST - Institution ien
+5 ; PIEN - Pasted text ien
+6 ; ARY - Array to return the pasted text data
+7 ; ZERO - 1 = Return zero node only
+8 ;
+9 ; Output
+10 ; ARY(0,0) - Total number of unique entries
+11 ; Or
+12 ; Error condition "-1^Error Msg"
+13 ;
+14 ; ARY(1..n,0) - (If ZERO = 1, then only node returned)
+15 ; Piece 1: Date/Time of the paste
+16 ; Piece 2: User who pasted text
+17 ; Piece 3: Copy from location (ien;file)
+18 ; Piece 4: Copy from document title
+19 ; Piece 5: Copy from document author (duz;name(last,first m))
+20 ; Piece 6: Copy from Patient (dfn;name(last,first m))
+21 ; Piece 7: Percent match between copied text and pasted text
+22 ; Piece 8: Number of lines of pasted text
+23 ; Piece 9: Capturing Application
+24 ; Piece 10: Date/Time of the copy from document
+25 ; Piece 11: Saved Paste IEN
+26 ; Piece 12: Parent IEN
+27 ; ARY(1,0,0) - Copy text line count
+28 ; ARY(1..n,0,1..n) - Copied text
+29 ; ARY(1..n,1..n) - Pasted text
+30 ;
+31 NEW CNT,CPYDATA0,CPYDFN,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYFIL,CPYPTNAME
+32 NEW CPYPTSRC,CPYUSER,DATA0,DTPST,IEN,LN,PCT,FILE,PRFX,PSTDUZ,PSTUSER
+33 NEW TIUERR,PIENLN,TIUNMSPC,X,NODISP,CPYFILNM,CPYGBLEN,FILENM,CPYFTXT
+34 NEW CPYLOC,CAPP,CPYSRCDT,PRNTIEN,TEXTLNG,X,LP
+35 SET TIUERR=""
+36 IF $GET(ARY)'[""
SET TIUERR="-1^Return array is required."
GOTO GTPSTQ
+37 IF $GET(INST)=""
SET TIUERR="-1^Institution is required"
GOTO GTPSTQ
+38 IF +INST<1
SET TIUERR="-1^Invalid institution"
GOTO GTPSTQ
+39 SET INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
+40 IF +INST<1
SET TIUERR="-1^Invalid institution"
GOTO GTPSTQ
+41 IF +$GET(PIEN)=0
SET TIUERR="-1^Pasted text ien is required."
GOTO GTPSTQ
+42 SET CNT=$SELECT(+$GET(ARY(0,0))'<0:+$GET(ARY(0,0)),1:0)
+43 SET IEN=PIEN
+44 ;S X=""
+45 ;F S X=$O(^TIUP(8928,"C",PIEN,X)) Q:X="" D
+46 ;. S IEN=$G(IEN)_U_X
+47 ;F LP=1:1:$L(IEN,U) D
+48 ;. S PIEN=$P(IEN,U,LP)
+49 SET DATA0=$GET(^TIUP(8928,PIEN,0))
+50 IF DATA0=""
QUIT
+51 SET PSTUSER=""
+52 SET DTPST=$PIECE(DATA0,U,1)
+53 SET PSTDUZ=$PIECE(DATA0,U,2)
+54 IF +PSTDUZ>0
SET PSTUSER=$$GET1^DIQ(200,PSTDUZ_",",.01)
+55 IF PSTUSER=""
SET PSTUSER="UNKNOWN PASTER NAME"
+56 SET CPYIEN=$PIECE(DATA0,U,6)
+57 SET CPYFIL=$PIECE(DATA0,U,7)
+58 SET CAPP=$PIECE(DATA0,U,9)
+59 SET PRNTIEN=$PIECE(DATA0,U,11)
+60 IF PRNTIEN=""
IF $DATA(^TIUP(8928,"C",PIEN))
SET PRNTIEN="+"
+61 ;S COMPLT=$P(DATA0,U,14)
+62 ;I COMPLT=0 Q
+63 SET CPYLOC=""
+64 SET CPYFILNM=""
+65 SET CPYFTXT=""
+66 IF CPYFIL'=""
Begin DoDot:1
+67 SET CPYFILNM=$$GET1^DIQ(1,CPYFIL_",",.01)
+68 SET CPYGBL=$$GET1^DIQ(1,CPYFIL_",",1)
+69 SET CPYGBLEN=CPYGBL_CPYIEN_")"
End DoDot:1
+70 IF CPYIEN=""
Begin DoDot:1
+71 SET CPYFTXT=$PIECE(DATA0,U,10)
+72 IF $PIECE(CPYFTXT," - ",1)="ORDER DETAILS"
Begin DoDot:2
+73 SET CPYIEN=$PIECE($PIECE(CPYFIL," - ",2),";",1)
+74 SET CPYFIL=100
End DoDot:2
End DoDot:1
+75 SET PCT=$PIECE(DATA0,U,8)
+76 SET CPYPTSRC=""
+77 SET CPYNAME=""
+78 SET CPYUSER=""
+79 SET CPYPTNAME=""
+80 SET CPYDUZ=""
+81 SET CPYUSER=""
+82 SET CPYDFN=""
+83 SET CPYSRCDT=""
+84 IF CPYFILNM="TIU DOCUMENT"
Begin DoDot:1
+85 ;REFERENCE DATE
SET CPYSRCDT=$PIECE($GET(^TIU(8925,CPYIEN,13)),U,1)
+86 ;AUTHOR/DICTATOR
SET CPYDUZ=$PIECE($GET(^TIU(CPYFIL,CPYIEN,12)),U,2)
+87 ;ENTERED BY
IF +CPYDUZ=0
SET CPYDUZ=$PIECE($GET(^TIU(CPYFIL,CPYIEN,13)),U,2)
+88 IF +CPYDUZ>0
SET CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
+89 IF CPYUSER=""
SET CPYUSER="UNKNOWN AUTHOR"
+90 SET CPYDATA0=$GET(^TIU(CPYFIL,CPYIEN,0))
+91 IF $GET(CPYDATA0)=""
QUIT
+92 SET CPYNAME=$PIECE(CPYDATA0,U,1)
+93 SET CPYNAME=$PIECE($GET(^TIU(8925.1,CPYNAME,0)),U,1)
+94 IF CPYNAME=""
SET CPYNAME="UNKNOWN NOTE TITLE"
+95 SET CPYDFN=$PIECE(CPYDATA0,U,2)
+96 IF +CPYDFN>0
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+97 IF CPYPTNAME=""
SET CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:1
+98 IF CPYFIL="100"
Begin DoDot:1
+99 SET CPYDATA0=$GET(^OR(CPYFIL,CPYIEN,0))
+100 IF $GET(CPYDATA0)=""
QUIT
+101 SET CPYSRCDT=$PIECE(CPYDATA0,U,7)
+102 ;WHO ENTERED
SET CPYDUZ=$PIECE(CPYDATA0,U,6)
+103 IF +CPYDUZ>0
SET CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
+104 IF CPYUSER=""
SET CPYUSER="UNKNOWN AUTHOR"
+105 SET CPYNAME="ORDER #"_$PIECE(CPYDATA0,U,1)
+106 IF +$PIECE(CPYNAME,"#",2)=0
SET CPYNAME="UNKNOWN ORDER NUMBER"
+107 ;ORDERABLE ITEMS (PATIENT/REFERRAL)
SET CPYDFN=$PIECE(CPYDATA0,U,2)
+108 IF +CPYDFN>0
Begin DoDot:2
+109 SET CPYGBL=$PIECE(CPYDFN,";",2)
+110 SET CPYDFN=+CPYDFN
End DoDot:2
+111 IF CPYGBL="DPT("
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+112 IF CPYGBL="LRT(67,"
SET CPYPTNAME=$PIECE($GET(^LRT(67,CPYDFN,0)),U,1)
SET CPYPTSRC="R"
+113 IF CPYPTNAME=""
SET CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:1
+114 IF CPYFILNM="REQUEST/CONSULTATION"
Begin DoDot:1
+115 SET CPYDATA0=$GET(^GMR(CPYFIL,CPYIEN,0))
+116 IF $GET(CPYDATA0)=""
QUIT
+117 SET CPYSRCDT=$PIECE(CPYDATA0,U,1)
+118 ;SENDING PROVIDER
SET CPYDUZ=$PIECE(CPYDATA0,U,14)
+119 IF +CPYDUZ>0
SET CPYUSER=$$GET1^DIQ(200,CPYDUZ_",",.01)
+120 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"
+121 IF CPYUSER=""
SET CPYUSER="UNKNOWN AUTHOR"
+122 SET CPYNAME="CONSULT #"_CPYIEN
+123 IF +$PIECE(CPYNAME,"#",2)=0
SET CPYNAME="UNKNOWN CONSULT NUMBER"
+124 ;PATIENT NAME (IEN)
SET CPYDFN=$PIECE(CPYDATA0,U,2)
+125 IF +CPYDFN>0
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+126 IF CPYPTNAME=""
SET CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:1
+127 IF $GET(CPYDATA0)=""
IF CPYFTXT=""
QUIT
+128 SET CPYLOC=$SELECT(CPYIEN'="":CPYIEN_";"_CPYFILNM,1:CPYFTXT)
+129 SET CNT=CNT+1
+130 SET ARY(CNT,0)=DTPST_U_$SELECT(+PSTDUZ>0:+PSTDUZ_";"_PSTUSER,1:"")_U_CPYLOC
+131 SET ARY(CNT,0)=$GET(ARY(CNT,0))_U_CPYNAME_U
+132 SET ARY(CNT,0)=$GET(ARY(CNT,0))_$SELECT(+CPYDUZ>0:+CPYDUZ_";"_CPYUSER,1:"")
+133 SET ARY(CNT,0)=$GET(ARY(CNT,0))_U_$SELECT(+CPYDFN>0:+CPYDFN_";"_CPYPTNAME,1:"")
+134 SET ARY(CNT,0)=$GET(ARY(CNT,0))_$SELECT(((CPYPTSRC="R")&(CPYPTSRC'="")):";"_CPYPTSRC,1:"")
+135 SET ARY(CNT,0)=$GET(ARY(CNT,0))_U_PCT_U_U_CAPP_U_CPYSRCDT_U_PIEN_U_PRNTIEN
+136 SET ARY(0,0)=CNT
+137 IF TIUERR'=""
SET ARY(0,0)=TIUERR
+138 IF +ZERO=1
QUIT
+139 SET LN=0
+140 SET X=""
+141 FOR
SET X=$ORDER(^TIUP(8928,PIEN,1,X))
if X=""
QUIT
Begin DoDot:1
+142 IF X=0
SET LN=$PIECE($GET(^TIUP(8928,PIEN,1,X)),U,4)
QUIT
+143 SET ARY(CNT,X)=$GET(^TIUP(8928,PIEN,1,X,0))
End DoDot:1
+144 SET $PIECE(ARY(CNT,0),U,8)=LN
+145 SET LN=0
+146 SET X=""
+147 FOR
SET X=$ORDER(^TIUP(8928,PIEN,2,X))
if X=""
QUIT
Begin DoDot:1
+148 IF X=0
SET LN=$PIECE($GET(^TIUP(8928,PIEN,2,X)),U,4)
QUIT
+149 SET ARY(CNT,0,X)=$GET(^TIUP(8928,PIEN,2,X,0))
End DoDot:1
+150 IF +LN>0
SET ARY(CNT,0,0)=LN
+151 SET ARY(0,0)=CNT
GTPSTQ IF TIUERR'=""
SET ARY(0,0)=TIUERR
+1 QUIT
