TIUCOPR1 ;SLC/TDP - Copy/Paste Report ;Jun 11, 2021@09:21:53
;;1.0;TEXT INTEGRATION UTILITIES;**290,338**;Jun 20, 1997;Build 9
;
; DBIA 2056 $$GET1^DIQ
; DBIA 2056 GETS^DIQ
; DBIA 2028 ^AUPNVSIT(
; DBIA 10035 ^DPT(
; DBIA 3162 ^GMR(123
; DBIA 3260 ^LRT(67
; DBIA 5771 ^OR(100
; DBIA 10040 ^SC(
; DBIA 10060 ^VA(200,
; DBIA 10103 $$FMTE^XLFDT
; DBIA 10103 $$NOW^XLFDT
; DBIA 10061 DEM^VADPT, KVA^VADPT
;
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,QUEUE)
Q
;
DETAIL1(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC,QUEUE) ;Detail Report
N APCT,CLNLOC,CLNNM,CPYDATA0,CPYDFN,CPYDT,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYOUT
N CPYPKG,CPYPTNAME,CPYPTSRC,CPYSRC,CPYUSER,DFN,DTPST,ENDT,IEN,LNCNT,LOC
N LOCTYP,LPDT,MIACPY,MIAPST,NOGO,NOTPAT,PARNT,PDIV,PDIVNM,PDIVS,PNVST,PNVST0
N PNVSTLOC,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=$P($G(^VA(200,PRVIEN,0)),U,1)
.. ;I PRVNM="" S PRVNM="UNKNOWN PASTER NAME"
.. 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="" 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 CPYUSER=""
.. S CPYDFN=""
.. 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
... I +PSTIEN>0 S PSTUSER=$P($G(^VA(200,PSTIEN,0)),U,1)
... ;I PSTUSER="" S PSTUSER="UNKNOWN AUTHOR"
... 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")
... ;I PSTPTNAME="" S PSTPTNAME="UNKNOWN PATIENT NAME"
... S PSTDT=$P(TIU13,U,1)
... S PSTNAME=$P(TIU0,U,1)
... S PSTNAME=$P($G(^TIU(8925.1,PSTNAME,0)),U,1)
... ;I PSTNAME="" S PSTNAME="UNKNOWN TITLE"
.. S CLNLOC=+$P(TIU12,U,5)
.. I +CLIN>0,'$D(CLIN(CLNLOC)) Q
.. S LOC=$G(^SC(CLNLOC,0))
.. S LOCTYP=$P(LOC,U,3)
.. I CLNLOC>0 S CLNNM=$P(LOC,U,1)
.. ;I CLNLOC=0 S CLNNM="UNKNOWN LOCATION"
.. S PNVST=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$FMTE^XLFDT($P(TIU0,U,7),7)
.. I CPYIEN="",CPYPKG="" 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 CPYDT="UNKNOWN"
.... ;S CPYUSER="UNKNOWN"
.... 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 CPYUSER="" S CPYUSER="UNKNOWN"
... ;I +$G(CPYDT)=0 S CPYDT="UNKNOWN"
... ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
.. 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
... I +CPYDUZ>0 S CPYUSER=$P($G(^VA(200,CPYDUZ,0)),U,1)
... ;I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
... S CPYDATA0=$G(TIUC0)
... S CPYDT=$P(TIUC13,U,1)
... S CPYNAME=$P(CPYDATA0,U,1)
... S CPYNAME=$P($G(^TIU(8925.1,CPYNAME,0)),U,1)
... ;I CPYNAME="" S CPYNAME="UNKNOWN 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 CPYPKG="100" D
... S CPYDATA0=$G(^OR(100,CPYIEN,0))
... S CPYDT=$P(CPYDATA0,U,7)
... S CPYDUZ=$P(CPYDATA0,U,6) ;WHO ENTERED
... I +CPYDUZ>0 S CPYUSER=$P($G(^VA(200,CPYDUZ,0)),U,1)
... ;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=$$GET1^DIQ(67,CPYDFN_",",.01)
... ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
.. 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
... I +CPYDUZ>0 S CPYUSER=$P($G(^VA(200,CPYDUZ,0)),U,1)
... I +CPYDUZ<1,$P($G(^GMR(123,CPYIEN,12)),U,6)'="" S CPYUSER=$P($G(^GMR(123,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"
.. S TIUOUT=$$FMTE^XLFDT(DTPST,7)_U_PSTPTNAME_U_PSTNAME_U_$$FMTE^XLFDT(PSTDT,7)_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
.. ;W !,PDIVNM_U_PNVST_U_CLNNM_U_$$FMTE^XLFDT(DTPST,7)_U_PSTPTNAME_U_PSTNAME
.. ;W U_$$FMTE^XLFDT(PSTDT,7)_U_PSTUSER_U_CPYPTNAME_U_CPYNAME
.. ;W U_$$FMTE^XLFDT(CPYDT,7)_U_CPYUSER_U_APCT_"%"
.. 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 9908 printed Dec 13, 2024@02:39:24 Page 2
TIUCOPR1 ;SLC/TDP - Copy/Paste Report ;Jun 11, 2021@09:21:53
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**290,338**;Jun 20, 1997;Build 9
+2 ;
+3 ; DBIA 2056 $$GET1^DIQ
+4 ; DBIA 2056 GETS^DIQ
+5 ; DBIA 2028 ^AUPNVSIT(
+6 ; DBIA 10035 ^DPT(
+7 ; DBIA 3162 ^GMR(123
+8 ; DBIA 3260 ^LRT(67
+9 ; DBIA 5771 ^OR(100
+10 ; DBIA 10040 ^SC(
+11 ; DBIA 10060 ^VA(200,
+12 ; DBIA 10103 $$FMTE^XLFDT
+13 ; DBIA 10103 $$NOW^XLFDT
+14 ; DBIA 10061 DEM^VADPT, KVA^VADPT
+15 ;
+16 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,QUEUE)
+2 QUIT
+3 ;
DETAIL1(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC,QUEUE) ;Detail Report
+1 NEW APCT,CLNLOC,CLNNM,CPYDATA0,CPYDFN,CPYDT,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYOUT
+2 NEW CPYPKG,CPYPTNAME,CPYPTSRC,CPYSRC,CPYUSER,DFN,DTPST,ENDT,IEN,LNCNT,LOC
+3 NEW LOCTYP,LPDT,MIACPY,MIAPST,NOGO,NOTPAT,PARNT,PDIV,PDIVNM,PDIVS,PNVST,PNVST0
+4 NEW PNVSTLOC,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=$PIECE($GET(^VA(200,PRVIEN,0)),U,1)
+26 ;I PRVNM="" S PRVNM="UNKNOWN PASTER NAME"
+27 SET PDIV=+$PIECE(PSTNT0,U,3)
+28 IF +DIV>0
IF '$DATA(DIV(PDIV))
QUIT
+29 SET PDIVS=PDIV_","
+30 KILL RSLT
+31 DO GETS^DIQ(4,PDIVS,".01;99","","RSLT")
+32 SET PDIVNM=$GET(RSLT(4,PDIVS,.01))
+33 SET PDIVNM=PDIVNM_" ("_$GET(RSLT(4,PDIVS,99))_")"
+34 SET CPYIEN=$PIECE(PSTNT0,U,6)
+35 SET CPYPKG=$PIECE(PSTNT0,U,7)
+36 IF CPYIEN>0
IF CPYPKG=""
SET CPYPKG=8925
+37 SET CPYSRC=$SELECT(CPYPKG=8925:"T",CPYPKG=100:"O",CPYPKG=123:"C",1:"")
+38 IF CPYSRC'=""
IF SRC'[CPYSRC
QUIT
+39 SET APCT=$PIECE(PSTNT0,U,8)
+40 IF APCT=""
SET APCT="??"
+41 SET CPYNAME=""
+42 SET CPYOUT=""
+43 SET CPYUSER=""
+44 SET CPYPTNAME=""
+45 SET CPYDUZ=""
+46 SET CPYUSER=""
+47 SET CPYDFN=""
+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 IF +PSTIEN>0
SET PSTUSER=$PIECE($GET(^VA(200,PSTIEN,0)),U,1)
+58 ;I PSTUSER="" S PSTUSER="UNKNOWN AUTHOR"
+59 SET PSTDFN=+$PIECE(TIU0,U,2)
+60 IF +PSTDFN>0
Begin DoDot:4
+61 SET DFN=+PSTDFN
+62 DO DEM^VADPT
+63 SET PSTPTNAME=$EXTRACT($GET(VADM(1)),1,20)_" ("_$GET(VA("BID"))_")"
+64 ;Cleans up VADPT variables including VA("BID") and VA("PID")
DO KVA^VADPT
End DoDot:4
+65 ;I PSTPTNAME="" S PSTPTNAME="UNKNOWN PATIENT NAME"
+66 SET PSTDT=$PIECE(TIU13,U,1)
+67 SET PSTNAME=$PIECE(TIU0,U,1)
+68 SET PSTNAME=$PIECE($GET(^TIU(8925.1,PSTNAME,0)),U,1)
+69 ;I PSTNAME="" S PSTNAME="UNKNOWN TITLE"
End DoDot:3
if NOTPAT
QUIT
+70 SET CLNLOC=+$PIECE(TIU12,U,5)
+71 IF +CLIN>0
IF '$DATA(CLIN(CLNLOC))
QUIT
+72 SET LOC=$GET(^SC(CLNLOC,0))
+73 SET LOCTYP=$PIECE(LOC,U,3)
+74 IF CLNLOC>0
SET CLNNM=$PIECE(LOC,U,1)
+75 ;I CLNLOC=0 S CLNNM="UNKNOWN LOCATION"
+76 SET PNVST=$SELECT(LOCTYP="W":"Adm: ",1:"Visit: ")_$$FMTE^XLFDT($PIECE(TIU0,U,7),7)
+77 IF CPYIEN=""
IF CPYPKG=""
Begin DoDot:3
+78 SET CPYOUT=$PIECE(PSTNT0,U,10)
+79 SET CPYNAME=$PIECE(CPYOUT,";",2)
+80 SET CPYPTNAME=$PIECE(CPYOUT,";",3)
+81 IF (CPYNAME["Outside of")!(CPYNAME["Percent Match fell below threshold")
Begin DoDot:4
+82 ;S CPYDT="UNKNOWN"
+83 ;S CPYUSER="UNKNOWN"
+84 SET CPYSRC=$SELECT(CPYNAME["Outside of":"X",1:"E")
End DoDot:4
+85 IF $PIECE(CPYNAME," - ",1)="ORDER DETAILS"
Begin DoDot:4
+86 SET CPYIEN=$PIECE($PIECE(CPYNAME," - ",2),";",1)
+87 SET CPYPKG="100"
SET CPYSRC="O"
End DoDot:4
+88 IF $PIECE(CPYNAME," - ",1)'="ORDER DETAILS"
Begin DoDot:4
+89 IF $PIECE(CPYOUT,";",4)'=""
SET CPYUSER=$PIECE(CPYOUT,";",3)
End DoDot:4
+90 ;I CPYUSER="" S CPYUSER="UNKNOWN"
+91 ;I +$G(CPYDT)=0 S CPYDT="UNKNOWN"
+92 ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:3
if SRC'[CPYSRC
QUIT
+93 IF CPYPKG="8925"
Begin DoDot:3
+94 IF '$DATA(^TIU(8925,CPYIEN))
SET MIACPY=1
QUIT
+95 SET TIUC0=$GET(^TIU(8925,CPYIEN,0))
+96 SET TIUC12=$GET(^TIU(8925,CPYIEN,12))
+97 SET TIUC13=$GET(^TIU(8925,CPYIEN,13))
+98 ;AUTHOR/DICTATOR
SET CPYDUZ=$PIECE(TIUC12,U,2)
+99 ;ENTERED BY
IF +CPYDUZ=0
SET CPYDUZ=$PIECE(TIUC13,U,2)
+100 IF +CPYDUZ>0
SET CPYUSER=$PIECE($GET(^VA(200,CPYDUZ,0)),U,1)
+101 ;I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
+102 SET CPYDATA0=$GET(TIUC0)
+103 SET CPYDT=$PIECE(TIUC13,U,1)
+104 SET CPYNAME=$PIECE(CPYDATA0,U,1)
+105 SET CPYNAME=$PIECE($GET(^TIU(8925.1,CPYNAME,0)),U,1)
+106 ;I CPYNAME="" S CPYNAME="UNKNOWN TITLE"
+107 SET CPYDFN=$PIECE(CPYDATA0,U,2)
+108 IF +CPYDFN>0
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+109 ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:3
if MIACPY=1
QUIT
+110 IF CPYPKG="100"
Begin DoDot:3
+111 SET CPYDATA0=$GET(^OR(100,CPYIEN,0))
+112 SET CPYDT=$PIECE(CPYDATA0,U,7)
+113 ;WHO ENTERED
SET CPYDUZ=$PIECE(CPYDATA0,U,6)
+114 IF +CPYDUZ>0
SET CPYUSER=$PIECE($GET(^VA(200,CPYDUZ,0)),U,1)
+115 ;I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
+116 SET CPYNAME="ORDER #"_$PIECE(CPYDATA0,U,1)
+117 ;I +$P(CPYNAME,"#",2)=0 S CPYNAME="UNKNOWN ORDER NUMBER"
+118 ;ORDERABLE ITEMS (PATIENT/REFERRAL)
SET CPYDFN=$PIECE(CPYDATA0,U,2)
+119 IF +CPYDFN>0
Begin DoDot:4
+120 SET CPYGBL=$PIECE(CPYDFN,";",2)
+121 SET CPYDFN=+CPYDFN
End DoDot:4
+122 IF CPYGBL="DPT("
SET CPYPTNAME=$PIECE($GET(^DPT(CPYDFN,0)),U,1)
+123 IF CPYGBL="LRT(67,"
SET CPYPTNAME=$$GET1^DIQ(67,CPYDFN_",",.01)
+124 ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:3
+125 IF CPYPKG="123"
Begin DoDot:3
+126 SET CPYDATA0=$GET(^GMR(123,CPYIEN,0))
+127 SET CPYDT=$PIECE(CPYDATA0,U,1)
+128 ;SENDING PROVIDER
SET CPYDUZ=$PIECE(CPYDATA0,U,14)
+129 IF +CPYDUZ>0
SET CPYUSER=$PIECE($GET(^VA(200,CPYDUZ,0)),U,1)
+130 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"
+131 ;I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
+132 SET CPYNAME="CONSULT #"_CPYIEN
+133 ;I +$P(CPYNAME,"#",2)=0 S 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 ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
End DoDot:3
+137 SET TIUOUT=$$FMTE^XLFDT(DTPST,7)_U_PSTPTNAME_U_PSTNAME_U_$$FMTE^XLFDT(PSTDT,7)_U_PSTUSER_U_CPYNAME_U_CPYUSER
+138 IF $LENGTH(TIUOUT)>255
Begin DoDot:3
+139 SET $PIECE(TIUOUT,U,3)=$EXTRACT(PSTNAME,1,40)
+140 IF $LENGTH(TIUOUT)'>255
QUIT
+141 SET $PIECE(TIUOUT,U,6)=$EXTRACT(CPYNAME,1,40)
End DoDot:3
+142 WRITE !,TIUOUT
+143 ;W !,PDIVNM_U_PNVST_U_CLNNM_U_$$FMTE^XLFDT(DTPST,7)_U_PSTPTNAME_U_PSTNAME
+144 ;W U_$$FMTE^XLFDT(PSTDT,7)_U_PSTUSER_U_CPYPTNAME_U_CPYNAME
+145 ;W U_$$FMTE^XLFDT(CPYDT,7)_U_CPYUSER_U_APCT_"%"
+146 QUIT
End DoDot:2
+147 QUIT
End DoDot:1
+148 IF QUEUE
DO MSG(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC)
+149 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
