TIUCOPR1 ;SLC/TDP - Copy/Paste Report ; Sep 22, 2025@15:36:20
;;1.0;TEXT INTEGRATION UTILITIES;**290,338,369**;Jun 20, 1997;Build 4
;
; Reference to $$GET1^DIQ, GETS^DIQ in ICR #2056
; Reference to ^DPT( in ICR #10035
; Reference to ^GMR(123 in ICR #2586
; Reference to ^LRT(67 in ICR #3260
; Reference to ^OR(100 in ICR #5771
; Reference to ^VA(200, in ICR #10060
; Reference to ^DIC(4 in ICR #10090
; Reference to $$FMTE^XLFDT in ICR #10103
; Reference to $$NOW^XLFDT in ICR #10103
; Reference to DEM^VADPT, KVA^VADPT in ICR #10061
; Reference to ^XMD in ICR #10070
;
Q
DETAILQ ;Detail Report (QUEUED)
;CLIN, DIV, DUZ, EDT, PROV, QUEUE, RUNDT, SDT, AND SRC EXIST FROM TIUCOPR QUEUE
D DETAIL1(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC,QUEUE)
Q
;
DETAIL(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC) ;Detail Report (NO QUEUE)
D DETAIL1(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC,0)
Q
;
DETAIL1(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC,QUEUE) ;Detail Report
N APCT,CLNLOC,CPYDATA0,CPYDFN,CPYDT,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYOUT
N CPYPKG,CPYPTNAME,CPYPTSRC,CPYSRC,CPYUSER,DFN,DTPST,ENDT,IEN,LNCNT,LPDT
N PDT,MIACPY,MIAPST,NOGO,NOTPAT,PARNT,PDIV,PDIVNM,PDIVS,PNVST,PNVST0
N PRVIEN,PRVNM,PSTDFN,PSTDT,PSTIEN,PSTNAME,PSTNT,PSTNT0,PSTPTNAME
N PSTUSER,RSLT,STDT,STRTDT,TIU0,TIU12,TIU13,TIUC0,TIUC12,TIUC13,TIUOUT,VA
N VADM
I $G(RUNDT)="" S RUNDT=$$NOW^XLFDT
W !,"PASTE DATE/TIME^PN PATIENT^PASTE NOTE (PN)^PN DATE/TIME^PN AUTHOR^COPY SOURCE (CS)^CS AUTHOR"
S ENDT=EDT+.999999
S (LPDT,STDT)=SDT-.000001
S STRTDT=9999999-LPDT
F S LPDT=$O(^TIUP(8928,"B",LPDT)) Q:((LPDT="")!(LPDT>ENDT)) D
. S IEN=""
. F S IEN=$O(^TIUP(8928,"B",LPDT,IEN)) Q:IEN="" D
.. S (PSTPTNAME,PSTNAME,PARNT)=""
.. S (MIACPY,MIAPST,NOGO)=0
.. S PSTNT0=$G(^TIUP(8928,IEN,0))
.. I PSTNT0="" Q
.. S PARNT=$P(PSTNT0,U,11)
.. I PARNT'="",PARNT'=IEN Q
.. S DTPST=$P(PSTNT0,U,1)
.. S PRVIEN=+$P(PSTNT0,U,2)
.. I +PROV>0,'$D(PROV(PRVIEN)) Q
.. S PRVNM=""
.. I PRVIEN>0 S PRVNM=$$GET1^DIQ(200,PRVIEN,.01)
.. S PDIV=+$P(PSTNT0,U,3)
.. I +DIV>0,'$D(DIV(PDIV)) Q
.. S PDIVS=PDIV_","
.. K RSLT
.. D GETS^DIQ(4,PDIVS,".01;99","","RSLT")
.. S PDIVNM=$G(RSLT(4,PDIVS,.01))
.. S PDIVNM=PDIVNM_" ("_$G(RSLT(4,PDIVS,99))_")"
.. S CPYIEN=+$P(PSTNT0,U,6)
.. S CPYPKG=+$P(PSTNT0,U,7)
.. I CPYIEN>0,CPYPKG=0 S CPYPKG=8925
.. S CPYSRC=$S(CPYPKG=8925:"T",CPYPKG=100:"O",CPYPKG=123:"C",1:"")
.. I CPYSRC'="",SRC'[CPYSRC Q
.. S APCT=$P(PSTNT0,U,8)
.. I APCT="" S APCT="??"
.. S CPYNAME=""
.. S CPYOUT=""
.. S CPYUSER=""
.. S CPYPTNAME=""
.. S CPYDUZ=""
.. S CPYDFN=""
.. S CPYGBL=""
.. S PSTUSER=""
.. S PSTNT=+$P(PSTNT0,U,4)
.. I '$D(^TIU(8925,PSTNT,0)) Q
.. S TIU0=$G(^TIU(8925,PSTNT,0))
.. S TIU12=$G(^TIU(8925,PSTNT,12))
.. S TIU13=$G(^TIU(8925,PSTNT,13))
.. S NOTPAT=0
.. I MIAPST'=1 D Q:NOTPAT
... S PSTIEN=+$P(TIU12,U,2) ;AUTHOR/DICTATOR
... I PSTIEN=0 S PSTIEN=+$P(TIU13,U,2) ;ENTERED BY
... S PSTUSER=$S(PSTIEN>0:$$GET1^DIQ(200,PSTIEN,.01),1:"")
... S PSTDFN=+$P(TIU0,U,2)
... I +PSTDFN>0 D
.... S DFN=+PSTDFN
.... D DEM^VADPT
.... S PSTPTNAME=$E($G(VADM(1)),1,20)_" ("_$G(VA("BID"))_")"
.... D KVA^VADPT ;Cleans up VADPT variables including VA("BID") and VA("PID")
... S PSTDT=$P(TIU13,U,1)
... S PSTNAME=$P(TIU0,U,1)
... S PSTNAME=$P($G(^TIU(8925.1,PSTNAME,0)),U,1)
.. S CLNLOC=+$P(TIU12,U,5)
.. I +CLIN>0,'$D(CLIN(CLNLOC)) Q
.. I CPYIEN=0,CPYPKG=0 D Q:SRC'[CPYSRC
... S CPYOUT=$P(PSTNT0,U,10)
... S CPYNAME=$P(CPYOUT,";",2)
... S CPYPTNAME=$P(CPYOUT,";",3)
... I (CPYNAME["Outside of")!(CPYNAME["Percent Match fell below threshold") D
.... S CPYSRC=$S(CPYNAME["Outside of":"X",1:"E")
... I $P(CPYNAME," - ",1)="ORDER DETAILS" D
.... S CPYIEN=+$P($P(CPYNAME," - ",2),";",1)
.... S CPYPKG="100",CPYSRC="O"
... I $P(CPYNAME," - ",1)'="ORDER DETAILS" D
.... I $P(CPYOUT,";",4)'="" S CPYUSER=$P(CPYOUT,";",3)
.. I CPYPKG="8925" D Q:MIACPY=1
... I '$D(^TIU(8925,CPYIEN)) S MIACPY=1 Q
... S TIUC0=$G(^TIU(8925,CPYIEN,0))
... S TIUC12=$G(^TIU(8925,CPYIEN,12))
... S TIUC13=$G(^TIU(8925,CPYIEN,13))
... S CPYDUZ=+$P(TIUC12,U,2) ;AUTHOR/DICTATOR
... I CPYDUZ=0 S CPYDUZ=+$P(TIUC13,U,2) ;ENTERED BY
... S CPYUSER=$S(CPYDUZ>0:$$GET1^DIQ(200,CPYDUZ,.01),1:"")
... S CPYDATA0=$G(TIUC0)
... S CPYDT=$P(TIUC13,U,1)
... S CPYNAME=+$P(CPYDATA0,U,1)
... S CPYNAME=$S(CPYNAME>0:$P($G(^TIU(8925.1,CPYNAME,0)),U,1),1:"")
... S CPYDFN=+$P(CPYDATA0,U,2)
... S CPYPTNAME=$S(CPYDFN>0:$P($G(^DPT(CPYDFN,0)),U,1),1:"")
.. I CPYPKG="100" D
... S CPYDATA0=$G(^OR(100,CPYIEN,0))
... S CPYDT=$P(CPYDATA0,U,7)
... S CPYDUZ=+$P(CPYDATA0,U,6) ;WHO ENTERED
... S CPYUSER=$S(CPYDUZ>0:$$GET1^DIQ(200,CPYDUZ,.01),1:"")
... S CPYNAME="ORDER #"_$S(CPYDATA0'="":$P(CPYDATA0,U,1),CPYIEN>0:CPYIEN,1:"")
... 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=$S(+CPYDFN>0:$P($G(^DPT(CPYDFN,0)),U,1),1:"")
... I CPYGBL="LRT(67," S CPYPTNAME=$S(+CPYDFN>0:$$GET1^DIQ(67,CPYDFN_",",.01),1:"")
.. I CPYPKG="123" D
... S CPYDATA0=$G(^GMR(123,CPYIEN,0))
... S CPYDT=$P(CPYDATA0,U,1)
... S CPYDUZ=+$P(CPYDATA0,U,14) ;SENDING PROVIDER
... S CPYUSER=$S(CPYDUZ>0:$$GET1^DIQ(200,CPYDUZ,.01),1:"")
... I CPYDUZ<1,$P($G(^GMR(123,CPYIEN,12)),U,6)'="" S CPYUSER=$P($G(^GMR(123,CPYIEN,12)),U,6),CPYDUZ="IFC"
... S CPYNAME="CONSULT #"_CPYIEN
... S CPYDFN=+$P(CPYDATA0,U,2) ;PATIENT NAME (IEN)
... S CPYPTNAME=$S(CPYDFN>0:$P($G(^DPT(CPYDFN,0)),U,1),1:"")
.. S TIUOUT=$S(+DTPST>0:$$FMTE^XLFDT(DTPST,7),0:"")_U_PSTPTNAME_U_PSTNAME_U_$S(+PSTDT>0:$$FMTE^XLFDT(PSTDT,7),1:"")_U_PSTUSER_U_CPYNAME_U_CPYUSER
.. I $L(TIUOUT)>255 D
... S $P(TIUOUT,U,3)=$E(PSTNAME,1,40)
... I $L(TIUOUT)'>255 Q
... S $P(TIUOUT,U,6)=$E(CPYNAME,1,40)
.. W !,TIUOUT
.. Q
. Q
I QUEUE D MSG(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC)
Q
MSG(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC) ;Send mail message to user who ran report
;IO,IOST are device related arrays/variables
N LNCNT,TIUDT,TXT,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ
S XMY(DUZ)=""
S XMTEXT="TXT("
S TIUDT=$$FMTE^XLFDT(RUNDT,1)
S XMSUB=TIUDT_" COPY/PASTE TRACKING REPORT COMPLETED"
S LNCNT=0
S LNCNT=LNCNT+1,TXT(LNCNT)="The COPY/PASTE TRACKING REPORT run at "_TIUDT_" has completed."
S LNCNT=LNCNT+1,TXT(LNCNT)=""
S LNCNT=LNCNT+1,TXT(LNCNT)="Report Parameters:"
S LNCNT=LNCNT+1,TXT(LNCNT)=""
S LNCNT=LNCNT+1,TXT(LNCNT)=" Start Date: "_$$FMTE^XLFDT(SDT,5)
S LNCNT=LNCNT+1,TXT(LNCNT)=" Stop Date: "_$$FMTE^XLFDT(EDT,5)
S LNCNT=LNCNT+1,TXT(LNCNT)=" Division(s): "
I DIV=0 S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
I DIV>0 D
. N DIVCNT,DIVNM,DIVIEN
. S DIVNM=""
. F S DIVNM=$O(DIV("B",DIVNM)) Q:DIVNM="" D
.. S DIVIEN=0
.. F S DIVIEN=$O(DIV("B",DIVNM,DIVIEN)) Q:DIVIEN="" D
... S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_DIVNM_" ("_$G(DIV("B",DIVNM,DIVIEN))_")"
... S LNCNT=LNCNT+1
... Q
.. Q
. S LNCNT=LNCNT-1
. Q
S LNCNT=LNCNT+1,TXT(LNCNT)=" Location(s): "
I CLIN=0 S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
I CLIN>0 D
. N CLINCNT,CLINNM,CLINIEN
. S CLINNM=""
. F S CLINNM=$O(CLIN("B",CLINNM)) Q:CLINNM="" D
.. S CLINIEN=0
.. F S CLINIEN=$O(CLIN("B",CLINNM,CLINIEN)) Q:CLINIEN="" D
... S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_CLINNM
... S LNCNT=LNCNT+1
... Q
.. Q
. S LNCNT=LNCNT-1
. Q
S LNCNT=LNCNT+1,TXT(LNCNT)=" Provider(s): "
I PROV=0 S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
I PROV>0 D
. N PROVCNT,PROVNM,PROVIEN
. S PROVNM=""
. F S PROVNM=$O(PROV("B",PROVNM)) Q:PROVNM="" D
.. S PROVIEN=0
.. F S PROVIEN=$O(PROV("B",PROVNM,PROVIEN)) Q:PROVIEN="" D
... S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_PROVNM
... S LNCNT=LNCNT+1
... Q
.. Q
. S LNCNT=LNCNT-1
. Q
S LNCNT=LNCNT+1,TXT(LNCNT)=" Source(s): "
I SRC["T",SRC["C",SRC["O",SRC["X",SRC["E" S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
E D
. I SRC["T" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_"T: TIU DOCUMENTS",LNCNT=LNCNT+1
. I SRC["C" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_"C: REQUEST/CONSULTATIONS",LNCNT=LNCNT+1
. I SRC["O" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_"O: ORDERS",LNCNT=LNCNT+1
. I SRC["X" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_"X: OUTSIDE OF CPRS",LNCNT=LNCNT+1
. I SRC["E" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:" ")_"E: EVERYTHING ELSE"
. Q
S LNCNT=LNCNT+1,TXT(LNCNT)=" Device: "_$G(IOST)
S TXT(LNCNT)=$G(TXT(LNCNT))_$S($G(IO("DOC"))'="":" ("_$G(IO("DOC")),$G(IO("HFSIO"))'="":" ("_$G(IO("HFSIO")),1:"")
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCOPR1 8897 printed Jul 22, 2026@15:48:18 Page 2
TIUCOPR1 ;SLC/TDP - Copy/Paste Report ; Sep 22, 2025@15:36:20
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**290,338,369**;Jun 20, 1997;Build 4
+2 ;
+3 ; Reference to $$GET1^DIQ, GETS^DIQ in ICR #2056
+4 ; Reference to ^DPT( in ICR #10035
+5 ; Reference to ^GMR(123 in ICR #2586
+6 ; Reference to ^LRT(67 in ICR #3260
+7 ; Reference to ^OR(100 in ICR #5771
+8 ; Reference to ^VA(200, in ICR #10060
+9 ; Reference to ^DIC(4 in ICR #10090
+10 ; Reference to $$FMTE^XLFDT in ICR #10103
+11 ; Reference to $$NOW^XLFDT in ICR #10103
+12 ; Reference to DEM^VADPT, KVA^VADPT in ICR #10061
+13 ; Reference to ^XMD in ICR #10070
+14 ;
+15 QUIT
DETAILQ ;Detail Report (QUEUED)
+1 ;CLIN, DIV, DUZ, EDT, PROV, QUEUE, RUNDT, SDT, AND SRC EXIST FROM TIUCOPR QUEUE
+2 DO DETAIL1(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC,QUEUE)
+3 QUIT
+4 ;
DETAIL(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC) ;Detail Report (NO QUEUE)
+1 DO DETAIL1(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC,0)
+2 QUIT
+3 ;
DETAIL1(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC,QUEUE) ;Detail Report
+1 NEW APCT,CLNLOC,CPYDATA0,CPYDFN,CPYDT,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYOUT
+2 NEW CPYPKG,CPYPTNAME,CPYPTSRC,CPYSRC,CPYUSER,DFN,DTPST,ENDT,IEN,LNCNT,LPDT
+3 NEW PDT,MIACPY,MIAPST,NOGO,NOTPAT,PARNT,PDIV,PDIVNM,PDIVS,PNVST,PNVST0
+4 NEW PRVIEN,PRVNM,PSTDFN,PSTDT,PSTIEN,PSTNAME,PSTNT,PSTNT0,PSTPTNAME
+5 NEW PSTUSER,RSLT,STDT,STRTDT,TIU0,TIU12,TIU13,TIUC0,TIUC12,TIUC13,TIUOUT,VA
+6 NEW VADM
+7 IF $GET(RUNDT)=""
SET RUNDT=$$NOW^XLFDT
+8 WRITE !,"PASTE DATE/TIME^PN PATIENT^PASTE NOTE (PN)^PN DATE/TIME^PN AUTHOR^COPY SOURCE (CS)^CS AUTHOR"
+9 SET ENDT=EDT+.999999
+10 SET (LPDT,STDT)=SDT-.000001
+11 SET STRTDT=9999999-LPDT
+12 FOR
SET LPDT=$ORDER(^TIUP(8928,"B",LPDT))
if ((LPDT="")!(LPDT>ENDT))
QUIT
Begin DoDot:1
+13 SET IEN=""
+14 FOR
SET IEN=$ORDER(^TIUP(8928,"B",LPDT,IEN))
if IEN=""
QUIT
Begin DoDot:2
+15 SET (PSTPTNAME,PSTNAME,PARNT)=""
+16 SET (MIACPY,MIAPST,NOGO)=0
+17 SET PSTNT0=$GET(^TIUP(8928,IEN,0))
+18 IF PSTNT0=""
QUIT
+19 SET PARNT=$PIECE(PSTNT0,U,11)
+20 IF PARNT'=""
IF PARNT'=IEN
QUIT
+21 SET DTPST=$PIECE(PSTNT0,U,1)
+22 SET PRVIEN=+$PIECE(PSTNT0,U,2)
+23 IF +PROV>0
IF '$DATA(PROV(PRVIEN))
QUIT
+24 SET PRVNM=""
+25 IF PRVIEN>0
SET PRVNM=$$GET1^DIQ(200,PRVIEN,.01)
+26 SET PDIV=+$PIECE(PSTNT0,U,3)
+27 IF +DIV>0
IF '$DATA(DIV(PDIV))
QUIT
+28 SET PDIVS=PDIV_","
+29 KILL RSLT
+30 DO GETS^DIQ(4,PDIVS,".01;99","","RSLT")
+31 SET PDIVNM=$GET(RSLT(4,PDIVS,.01))
+32 SET PDIVNM=PDIVNM_" ("_$GET(RSLT(4,PDIVS,99))_")"
+33 SET CPYIEN=+$PIECE(PSTNT0,U,6)
+34 SET CPYPKG=+$PIECE(PSTNT0,U,7)
+35 IF CPYIEN>0
IF CPYPKG=0
SET CPYPKG=8925
+36 SET CPYSRC=$SELECT(CPYPKG=8925:"T",CPYPKG=100:"O",CPYPKG=123:"C",1:"")
+37 IF CPYSRC'=""
IF SRC'[CPYSRC
QUIT
+38 SET APCT=$PIECE(PSTNT0,U,8)
+39 IF APCT=""
SET APCT="??"
+40 SET CPYNAME=""
+41 SET CPYOUT=""
+42 SET CPYUSER=""
+43 SET CPYPTNAME=""
+44 SET CPYDUZ=""
+45 SET CPYDFN=""
+46 SET CPYGBL=""
+47 SET PSTUSER=""
+48 SET PSTNT=+$PIECE(PSTNT0,U,4)
+49 IF '$DATA(^TIU(8925,PSTNT,0))
QUIT
+50 SET TIU0=$GET(^TIU(8925,PSTNT,0))
+51 SET TIU12=$GET(^TIU(8925,PSTNT,12))
+52 SET TIU13=$GET(^TIU(8925,PSTNT,13))
+53 SET NOTPAT=0
+54 IF MIAPST'=1
Begin DoDot:3
+55 ;AUTHOR/DICTATOR
SET PSTIEN=+$PIECE(TIU12,U,2)
+56 ;ENTERED BY
IF PSTIEN=0
SET PSTIEN=+$PIECE(TIU13,U,2)
+57 SET PSTUSER=$SELECT(PSTIEN>0:$$GET1^DIQ(200,PSTIEN,.01),1:"")
+58 SET PSTDFN=+$PIECE(TIU0,U,2)
+59 IF +PSTDFN>0
Begin DoDot:4
+60 SET DFN=+PSTDFN
+61 DO DEM^VADPT
+62 SET PSTPTNAME=$EXTRACT($GET(VADM(1)),1,20)_" ("_$GET(VA("BID"))_")"
+63 ;Cleans up VADPT variables including VA("BID") and VA("PID")
DO KVA^VADPT
End DoDot:4
+64 SET PSTDT=$PIECE(TIU13,U,1)
+65 SET PSTNAME=$PIECE(TIU0,U,1)
+66 SET PSTNAME=$PIECE($GET(^TIU(8925.1,PSTNAME,0)),U,1)
End DoDot:3
if NOTPAT
QUIT
+67 SET CLNLOC=+$PIECE(TIU12,U,5)
+68 IF +CLIN>0
IF '$DATA(CLIN(CLNLOC))
QUIT
+69 IF CPYIEN=0
IF CPYPKG=0
Begin DoDot:3
+70 SET CPYOUT=$PIECE(PSTNT0,U,10)
+71 SET CPYNAME=$PIECE(CPYOUT,";",2)
+72 SET CPYPTNAME=$PIECE(CPYOUT,";",3)
+73 IF (CPYNAME["Outside of")!(CPYNAME["Percent Match fell below threshold")
Begin DoDot:4
+74 SET CPYSRC=$SELECT(CPYNAME["Outside of":"X",1:"E")
End DoDot:4
+75 IF $PIECE(CPYNAME," - ",1)="ORDER DETAILS"
Begin DoDot:4
+76 SET CPYIEN=+$PIECE($PIECE(CPYNAME," - ",2),";",1)
+77 SET CPYPKG="100"
SET CPYSRC="O"
End DoDot:4
+78 IF $PIECE(CPYNAME," - ",1)'="ORDER DETAILS"
Begin DoDot:4
+79 IF $PIECE(CPYOUT,";",4)'=""
SET CPYUSER=$PIECE(CPYOUT,";",3)
End DoDot:4
End DoDot:3
if SRC'[CPYSRC
QUIT
+80 IF CPYPKG="8925"
Begin DoDot:3
+81 IF '$DATA(^TIU(8925,CPYIEN))
SET MIACPY=1
QUIT
+82 SET TIUC0=$GET(^TIU(8925,CPYIEN,0))
+83 SET TIUC12=$GET(^TIU(8925,CPYIEN,12))
+84 SET TIUC13=$GET(^TIU(8925,CPYIEN,13))
+85 ;AUTHOR/DICTATOR
SET CPYDUZ=+$PIECE(TIUC12,U,2)
+86 ;ENTERED BY
IF CPYDUZ=0
SET CPYDUZ=+$PIECE(TIUC13,U,2)
+87 SET CPYUSER=$SELECT(CPYDUZ>0:$$GET1^DIQ(200,CPYDUZ,.01),1:"")
+88 SET CPYDATA0=$GET(TIUC0)
+89 SET CPYDT=$PIECE(TIUC13,U,1)
+90 SET CPYNAME=+$PIECE(CPYDATA0,U,1)
+91 SET CPYNAME=$SELECT(CPYNAME>0:$PIECE($GET(^TIU(8925.1,CPYNAME,0)),U,1),1:"")
+92 SET CPYDFN=+$PIECE(CPYDATA0,U,2)
+93 SET CPYPTNAME=$SELECT(CPYDFN>0:$PIECE($GET(^DPT(CPYDFN,0)),U,1),1:"")
End DoDot:3
if MIACPY=1
QUIT
+94 IF CPYPKG="100"
Begin DoDot:3
+95 SET CPYDATA0=$GET(^OR(100,CPYIEN,0))
+96 SET CPYDT=$PIECE(CPYDATA0,U,7)
+97 ;WHO ENTERED
SET CPYDUZ=+$PIECE(CPYDATA0,U,6)
+98 SET CPYUSER=$SELECT(CPYDUZ>0:$$GET1^DIQ(200,CPYDUZ,.01),1:"")
+99 SET CPYNAME="ORDER #"_$SELECT(CPYDATA0'="":$PIECE(CPYDATA0,U,1),CPYIEN>0:CPYIEN,1:"")
+100 ;ORDERABLE ITEMS (PATIENT/REFERRAL)
SET CPYDFN=$PIECE(CPYDATA0,U,2)
+101 IF +CPYDFN>0
Begin DoDot:4
+102 SET CPYGBL=$PIECE(CPYDFN,";",2)
+103 SET CPYDFN=+CPYDFN
End DoDot:4
+104 IF CPYGBL="DPT("
SET CPYPTNAME=$SELECT(+CPYDFN>0:$PIECE($GET(^DPT(CPYDFN,0)),U,1),1:"")
+105 IF CPYGBL="LRT(67,"
SET CPYPTNAME=$SELECT(+CPYDFN>0:$$GET1^DIQ(67,CPYDFN_",",.01),1:"")
End DoDot:3
+106 IF CPYPKG="123"
Begin DoDot:3
+107 SET CPYDATA0=$GET(^GMR(123,CPYIEN,0))
+108 SET CPYDT=$PIECE(CPYDATA0,U,1)
+109 ;SENDING PROVIDER
SET CPYDUZ=+$PIECE(CPYDATA0,U,14)
+110 SET CPYUSER=$SELECT(CPYDUZ>0:$$GET1^DIQ(200,CPYDUZ,.01),1:"")
+111 IF CPYDUZ<1
IF $PIECE($GET(^GMR(123,CPYIEN,12)),U,6)'=""
SET CPYUSER=$PIECE($GET(^GMR(123,CPYIEN,12)),U,6)
SET CPYDUZ="IFC"
+112 SET CPYNAME="CONSULT #"_CPYIEN
+113 ;PATIENT NAME (IEN)
SET CPYDFN=+$PIECE(CPYDATA0,U,2)
+114 SET CPYPTNAME=$SELECT(CPYDFN>0:$PIECE($GET(^DPT(CPYDFN,0)),U,1),1:"")
End DoDot:3
+115 SET TIUOUT=$SELECT(+DTPST>0:$$FMTE^XLFDT(DTPST,7),0:"")_U_PSTPTNAME_U_PSTNAME_U_$SELECT(+PSTDT>0:$$FMTE^XLFDT(PSTDT,7),1:"")_U_PSTUSER_U_CPYNAME_U_CPYUSER
+116 IF $LENGTH(TIUOUT)>255
Begin DoDot:3
+117 SET $PIECE(TIUOUT,U,3)=$EXTRACT(PSTNAME,1,40)
+118 IF $LENGTH(TIUOUT)'>255
QUIT
+119 SET $PIECE(TIUOUT,U,6)=$EXTRACT(CPYNAME,1,40)
End DoDot:3
+120 WRITE !,TIUOUT
+121 QUIT
End DoDot:2
+122 QUIT
End DoDot:1
+123 IF QUEUE
DO MSG(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC)
+124 QUIT
MSG(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC) ;Send mail message to user who ran report
+1 ;IO,IOST are device related arrays/variables
+2 NEW LNCNT,TIUDT,TXT,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ
+3 SET XMY(DUZ)=""
+4 SET XMTEXT="TXT("
+5 SET TIUDT=$$FMTE^XLFDT(RUNDT,1)
+6 SET XMSUB=TIUDT_" COPY/PASTE TRACKING REPORT COMPLETED"
+7 SET LNCNT=0
+8 SET LNCNT=LNCNT+1
SET TXT(LNCNT)="The COPY/PASTE TRACKING REPORT run at "_TIUDT_" has completed."
+9 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=""
+10 SET LNCNT=LNCNT+1
SET TXT(LNCNT)="Report Parameters:"
+11 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=""
+12 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=" Start Date: "_$$FMTE^XLFDT(SDT,5)
+13 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=" Stop Date: "_$$FMTE^XLFDT(EDT,5)
+14 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=" Division(s): "
+15 IF DIV=0
SET TXT(LNCNT)=$GET(TXT(LNCNT))_"ALL"
+16 IF DIV>0
Begin DoDot:1
+17 NEW DIVCNT,DIVNM,DIVIEN
+18 SET DIVNM=""
+19 FOR
SET DIVNM=$ORDER(DIV("B",DIVNM))
if DIVNM=""
QUIT
Begin DoDot:2
+20 SET DIVIEN=0
+21 FOR
SET DIVIEN=$ORDER(DIV("B",DIVNM,DIVIEN))
if DIVIEN=""
QUIT
Begin DoDot:3
+22 SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_DIVNM_" ("_$GET(DIV("B",DIVNM,DIVIEN))_")"
+23 SET LNCNT=LNCNT+1
+24 QUIT
End DoDot:3
+25 QUIT
End DoDot:2
+26 SET LNCNT=LNCNT-1
+27 QUIT
End DoDot:1
+28 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=" Location(s): "
+29 IF CLIN=0
SET TXT(LNCNT)=$GET(TXT(LNCNT))_"ALL"
+30 IF CLIN>0
Begin DoDot:1
+31 NEW CLINCNT,CLINNM,CLINIEN
+32 SET CLINNM=""
+33 FOR
SET CLINNM=$ORDER(CLIN("B",CLINNM))
if CLINNM=""
QUIT
Begin DoDot:2
+34 SET CLINIEN=0
+35 FOR
SET CLINIEN=$ORDER(CLIN("B",CLINNM,CLINIEN))
if CLINIEN=""
QUIT
Begin DoDot:3
+36 SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_CLINNM
+37 SET LNCNT=LNCNT+1
+38 QUIT
End DoDot:3
+39 QUIT
End DoDot:2
+40 SET LNCNT=LNCNT-1
+41 QUIT
End DoDot:1
+42 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=" Provider(s): "
+43 IF PROV=0
SET TXT(LNCNT)=$GET(TXT(LNCNT))_"ALL"
+44 IF PROV>0
Begin DoDot:1
+45 NEW PROVCNT,PROVNM,PROVIEN
+46 SET PROVNM=""
+47 FOR
SET PROVNM=$ORDER(PROV("B",PROVNM))
if PROVNM=""
QUIT
Begin DoDot:2
+48 SET PROVIEN=0
+49 FOR
SET PROVIEN=$ORDER(PROV("B",PROVNM,PROVIEN))
if PROVIEN=""
QUIT
Begin DoDot:3
+50 SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_PROVNM
+51 SET LNCNT=LNCNT+1
+52 QUIT
End DoDot:3
+53 QUIT
End DoDot:2
+54 SET LNCNT=LNCNT-1
+55 QUIT
End DoDot:1
+56 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=" Source(s): "
+57 IF SRC["T"
IF SRC["C"
IF SRC["O"
IF SRC["X"
IF SRC["E"
SET TXT(LNCNT)=$GET(TXT(LNCNT))_"ALL"
+58 IF '$TEST
Begin DoDot:1
+59 IF SRC["T"
SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_"T: TIU DOCUMENTS"
SET LNCNT=LNCNT+1
+60 IF SRC["C"
SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_"C: REQUEST/CONSULTATIONS"
SET LNCNT=LNCNT+1
+61 IF SRC["O"
SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_"O: ORDERS"
SET LNCNT=LNCNT+1
+62 IF SRC["X"
SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_"X: OUTSIDE OF CPRS"
SET LNCNT=LNCNT+1
+63 IF SRC["E"
SET TXT(LNCNT)=$SELECT($LENGTH($GET(TXT(LNCNT)))>0:$GET(TXT(LNCNT)),1:" ")_"E: EVERYTHING ELSE"
+64 QUIT
End DoDot:1
+65 SET LNCNT=LNCNT+1
SET TXT(LNCNT)=" Device: "_$GET(IOST)
+66 SET TXT(LNCNT)=$GET(TXT(LNCNT))_$SELECT($GET(IO("DOC"))'="":" ("_$GET(IO("DOC")),$GET(IO("HFSIO"))'="":" ("_$GET(IO("HFSIO")),1:"")
+67 DO ^XMD
+68 QUIT
