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

TIUCOPR1.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;   DBIA 2056   $$GET1^DIQ
  1.  ;   DBIA 2056   GETS^DIQ
  1.  ;   DBIA 2028   ^AUPNVSIT(
  1.  ;   DBIA 10035  ^DPT(
  1.  ;   DBIA 3162   ^GMR(123
  1.  ;   DBIA 3260   ^LRT(67
  1.  ;   DBIA 5771   ^OR(100
  1.  ;   DBIA 10040  ^SC(
  1.  ;   DBIA 10060  ^VA(200,
  1.  ;   DBIA 10103  $$FMTE^XLFDT
  1.  ;   DBIA 10103  $$NOW^XLFDT
  1.  ;   DBIA 10061  DEM^VADPT, KVA^VADPT
  1.  ;
  1.  Q
  1. DETAILQ ;Detail Report (QUEUED)
  1.  ;CLIN, DIV, DUZ, EDT, PROV, QUEUE, RUNDT, SDT, AND SRC EXIST FROM TIUCOPR QUEUE
  1.  D DETAIL1(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC,QUEUE)
  1.  Q
  1.  ;
  1. DETAIL(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC) ;Detail Report (NO QUEUE)
  1.  D DETAIL1(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC,QUEUE)
  1.  Q
  1.  ;
  1. DETAIL1(CLIN,DIV,DUZ,EDT,PROV,RUNDT,SDT,SRC,QUEUE) ;Detail Report
  1.  N APCT,CLNLOC,CLNNM,CPYDATA0,CPYDFN,CPYDT,CPYDUZ,CPYGBL,CPYIEN,CPYNAME,CPYOUT
  1.  N CPYPKG,CPYPTNAME,CPYPTSRC,CPYSRC,CPYUSER,DFN,DTPST,ENDT,IEN,LNCNT,LOC
  1.  N LOCTYP,LPDT,MIACPY,MIAPST,NOGO,NOTPAT,PARNT,PDIV,PDIVNM,PDIVS,PNVST,PNVST0
  1.  N PNVSTLOC,PRVIEN,PRVNM,PSTDFN,PSTDT,PSTIEN,PSTNAME,PSTNT,PSTNT0,PSTPTNAME
  1.  N PSTUSER,RSLT,STDT,STRTDT,TIU0,TIU12,TIU13,TIUC0,TIUC12,TIUC13,TIUOUT,VA
  1.  N VADM
  1.  I $G(RUNDT)="" S RUNDT=$$NOW^XLFDT
  1.  W !,"PASTE DATE/TIME^PN PATIENT^PASTE NOTE (PN)^PN DATE/TIME^PN AUTHOR^COPY SOURCE (CS)^CS AUTHOR"
  1.  S ENDT=EDT+.999999
  1.  S (LPDT,STDT)=SDT-.000001
  1.  S STRTDT=9999999-LPDT
  1.  F  S LPDT=$O(^TIUP(8928,"B",LPDT)) Q:((LPDT="")!(LPDT>ENDT))  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^TIUP(8928,"B",LPDT,IEN)) Q:IEN=""  D
  1.  .. S (PSTPTNAME,PSTNAME,PARNT)=""
  1.  .. S (MIACPY,MIAPST,NOGO)=0
  1.  .. S PSTNT0=$G(^TIUP(8928,IEN,0))
  1.  .. I PSTNT0="" Q
  1.  .. S PARNT=$P(PSTNT0,U,11)
  1.  .. I PARNT'="",PARNT'=IEN Q
  1.  .. S DTPST=$P(PSTNT0,U,1)
  1.  .. S PRVIEN=+$P(PSTNT0,U,2)
  1.  .. I +PROV>0,'$D(PROV(PRVIEN)) Q
  1.  .. S PRVNM=""
  1.  .. I +PRVIEN>0 S PRVNM=$P($G(^VA(200,PRVIEN,0)),U,1)
  1.  .. ;I PRVNM="" S PRVNM="UNKNOWN PASTER NAME"
  1.  .. S PDIV=+$P(PSTNT0,U,3)
  1.  .. I +DIV>0,'$D(DIV(PDIV)) Q
  1.  .. S PDIVS=PDIV_","
  1.  .. K RSLT
  1.  .. D GETS^DIQ(4,PDIVS,".01;99","","RSLT")
  1.  .. S PDIVNM=$G(RSLT(4,PDIVS,.01))
  1.  .. S PDIVNM=PDIVNM_" ("_$G(RSLT(4,PDIVS,99))_")"
  1.  .. S CPYIEN=$P(PSTNT0,U,6)
  1.  .. S CPYPKG=$P(PSTNT0,U,7)
  1.  .. I CPYIEN>0,CPYPKG="" S CPYPKG=8925
  1.  .. S CPYSRC=$S(CPYPKG=8925:"T",CPYPKG=100:"O",CPYPKG=123:"C",1:"")
  1.  .. I CPYSRC'="",SRC'[CPYSRC Q
  1.  .. S APCT=$P(PSTNT0,U,8)
  1.  .. I APCT="" S APCT="??"
  1.  .. S CPYNAME=""
  1.  .. S CPYOUT=""
  1.  .. S CPYUSER=""
  1.  .. S CPYPTNAME=""
  1.  .. S CPYDUZ=""
  1.  .. S CPYUSER=""
  1.  .. S CPYDFN=""
  1.  .. S PSTNT=+$P(PSTNT0,U,4)
  1.  .. I '$D(^TIU(8925,PSTNT,0)) Q
  1.  .. S TIU0=$G(^TIU(8925,PSTNT,0))
  1.  .. S TIU12=$G(^TIU(8925,PSTNT,12))
  1.  .. S TIU13=$G(^TIU(8925,PSTNT,13))
  1.  .. S NOTPAT=0
  1.  .. I MIAPST'=1 D  Q:NOTPAT
  1.  ... S PSTIEN=$P(TIU12,U,2) ;AUTHOR/DICTATOR
  1.  ... I +PSTIEN=0 S PSTIEN=$P(TIU13,U,2) ;ENTERED BY
  1.  ... I +PSTIEN>0 S PSTUSER=$P($G(^VA(200,PSTIEN,0)),U,1)
  1.  ... ;I PSTUSER="" S PSTUSER="UNKNOWN AUTHOR"
  1.  ... S PSTDFN=+$P(TIU0,U,2)
  1.  ... I +PSTDFN>0 D
  1.  .... S DFN=+PSTDFN
  1.  .... D DEM^VADPT
  1.  .... S PSTPTNAME=$E($G(VADM(1)),1,20)_" ("_$G(VA("BID"))_")"
  1.  .... D KVA^VADPT ;Cleans up VADPT variables including VA("BID") and VA("PID")
  1.  ... ;I PSTPTNAME="" S PSTPTNAME="UNKNOWN PATIENT NAME"
  1.  ... S PSTDT=$P(TIU13,U,1)
  1.  ... S PSTNAME=$P(TIU0,U,1)
  1.  ... S PSTNAME=$P($G(^TIU(8925.1,PSTNAME,0)),U,1)
  1.  ... ;I PSTNAME="" S PSTNAME="UNKNOWN TITLE"
  1.  .. S CLNLOC=+$P(TIU12,U,5)
  1.  .. I +CLIN>0,'$D(CLIN(CLNLOC)) Q
  1.  .. S LOC=$G(^SC(CLNLOC,0))
  1.  .. S LOCTYP=$P(LOC,U,3)
  1.  .. I CLNLOC>0 S CLNNM=$P(LOC,U,1)
  1.  .. ;I CLNLOC=0 S CLNNM="UNKNOWN LOCATION"
  1.  .. S PNVST=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$FMTE^XLFDT($P(TIU0,U,7),7)
  1.  .. I CPYIEN="",CPYPKG="" D  Q:SRC'[CPYSRC
  1.  ... S CPYOUT=$P(PSTNT0,U,10)
  1.  ... S CPYNAME=$P(CPYOUT,";",2)
  1.  ... S CPYPTNAME=$P(CPYOUT,";",3)
  1.  ... I (CPYNAME["Outside of")!(CPYNAME["Percent Match fell below threshold") D
  1.  .... ;S CPYDT="UNKNOWN"
  1.  .... ;S CPYUSER="UNKNOWN"
  1.  .... S CPYSRC=$S(CPYNAME["Outside of":"X",1:"E")
  1.  ... I $P(CPYNAME," - ",1)="ORDER DETAILS" D
  1.  .... S CPYIEN=$P($P(CPYNAME," - ",2),";",1)
  1.  .... S CPYPKG="100",CPYSRC="O"
  1.  ... I $P(CPYNAME," - ",1)'="ORDER DETAILS" D
  1.  .... I $P(CPYOUT,";",4)'="" S CPYUSER=$P(CPYOUT,";",3)
  1.  ... ;I CPYUSER="" S CPYUSER="UNKNOWN"
  1.  ... ;I +$G(CPYDT)=0 S CPYDT="UNKNOWN"
  1.  ... ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
  1.  .. I CPYPKG="8925" D  Q:MIACPY=1
  1.  ... I '$D(^TIU(8925,CPYIEN)) S MIACPY=1 Q
  1.  ... S TIUC0=$G(^TIU(8925,CPYIEN,0))
  1.  ... S TIUC12=$G(^TIU(8925,CPYIEN,12))
  1.  ... S TIUC13=$G(^TIU(8925,CPYIEN,13))
  1.  ... S CPYDUZ=$P(TIUC12,U,2) ;AUTHOR/DICTATOR
  1.  ... I +CPYDUZ=0 S CPYDUZ=$P(TIUC13,U,2) ;ENTERED BY
  1.  ... I +CPYDUZ>0 S CPYUSER=$P($G(^VA(200,CPYDUZ,0)),U,1)
  1.  ... ;I CPYUSER="" S CPYUSER="UNKNOWN AUTHOR"
  1.  ... S CPYDATA0=$G(TIUC0)
  1.  ... S CPYDT=$P(TIUC13,U,1)
  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 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 CPYPKG="100" D
  1.  ... S CPYDATA0=$G(^OR(100,CPYIEN,0))
  1.  ... S CPYDT=$P(CPYDATA0,U,7)
  1.  ... S CPYDUZ=$P(CPYDATA0,U,6) ;WHO ENTERED
  1.  ... I +CPYDUZ>0 S CPYUSER=$P($G(^VA(200,CPYDUZ,0)),U,1)
  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=$$GET1^DIQ(67,CPYDFN_",",.01)
  1.  ... ;I CPYPTNAME="" S CPYPTNAME="UNKNOWN PATIENT NAME"
  1.  .. I CPYPKG="123" D
  1.  ... S CPYDATA0=$G(^GMR(123,CPYIEN,0))
  1.  ... S CPYDT=$P(CPYDATA0,U,1)
  1.  ... S CPYDUZ=$P(CPYDATA0,U,14) ;SENDING PROVIDER
  1.  ... I +CPYDUZ>0 S CPYUSER=$P($G(^VA(200,CPYDUZ,0)),U,1)
  1.  ... I +CPYDUZ<1,$P($G(^GMR(123,CPYIEN,12)),U,6)'="" S CPYUSER=$P($G(^GMR(123,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.  .. S TIUOUT=$$FMTE^XLFDT(DTPST,7)_U_PSTPTNAME_U_PSTNAME_U_$$FMTE^XLFDT(PSTDT,7)_U_PSTUSER_U_CPYNAME_U_CPYUSER
  1.  .. I $L(TIUOUT)>255 D
  1.  ... S $P(TIUOUT,U,3)=$E(PSTNAME,1,40)
  1.  ... I $L(TIUOUT)'>255 Q
  1.  ... S $P(TIUOUT,U,6)=$E(CPYNAME,1,40)
  1.  .. W !,TIUOUT
  1.  .. ;W !,PDIVNM_U_PNVST_U_CLNNM_U_$$FMTE^XLFDT(DTPST,7)_U_PSTPTNAME_U_PSTNAME
  1.  .. ;W U_$$FMTE^XLFDT(PSTDT,7)_U_PSTUSER_U_CPYPTNAME_U_CPYNAME
  1.  .. ;W U_$$FMTE^XLFDT(CPYDT,7)_U_CPYUSER_U_APCT_"%"
  1.  .. Q
  1.  . Q
  1.  I QUEUE D MSG(.CLIN,.DIV,DUZ,EDT,.PROV,RUNDT,SDT,SRC)
  1.  Q
  1. 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
  1.  N LNCNT,TIUDT,TXT,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ
  1.  S XMY(DUZ)=""
  1.  S XMTEXT="TXT("
  1.  S TIUDT=$$FMTE^XLFDT(RUNDT,1)
  1.  S XMSUB=TIUDT_" COPY/PASTE TRACKING REPORT COMPLETED"
  1.  S LNCNT=0
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="The COPY/PASTE TRACKING REPORT run at "_TIUDT_" has completed."
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)=""
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="Report Parameters:"
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)=""
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="   Start Date: "_$$FMTE^XLFDT(SDT,5)
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="    Stop Date: "_$$FMTE^XLFDT(EDT,5)
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="  Division(s): "
  1.  I DIV=0 S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
  1.  I DIV>0 D
  1.  . N DIVCNT,DIVNM,DIVIEN
  1.  . S DIVNM=""
  1.  . F  S DIVNM=$O(DIV("B",DIVNM)) Q:DIVNM=""  D
  1.  .. S DIVIEN=0
  1.  .. F  S DIVIEN=$O(DIV("B",DIVNM,DIVIEN)) Q:DIVIEN=""  D
  1.  ... S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_DIVNM_" ("_$G(DIV("B",DIVNM,DIVIEN))_")"
  1.  ... S LNCNT=LNCNT+1
  1.  ... Q
  1.  .. Q
  1.  . S LNCNT=LNCNT-1
  1.  . Q
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="  Location(s): "
  1.  I CLIN=0 S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
  1.  I CLIN>0 D
  1.  . N CLINCNT,CLINNM,CLINIEN
  1.  . S CLINNM=""
  1.  . F  S CLINNM=$O(CLIN("B",CLINNM)) Q:CLINNM=""  D
  1.  .. S CLINIEN=0
  1.  .. F  S CLINIEN=$O(CLIN("B",CLINNM,CLINIEN)) Q:CLINIEN=""  D
  1.  ... S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_CLINNM
  1.  ... S LNCNT=LNCNT+1
  1.  ... Q
  1.  .. Q
  1.  . S LNCNT=LNCNT-1
  1.  . Q
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="  Provider(s): "
  1.  I PROV=0 S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
  1.  I PROV>0 D
  1.  . N PROVCNT,PROVNM,PROVIEN
  1.  . S PROVNM=""
  1.  . F  S PROVNM=$O(PROV("B",PROVNM)) Q:PROVNM=""  D
  1.  .. S PROVIEN=0
  1.  .. F  S PROVIEN=$O(PROV("B",PROVNM,PROVIEN)) Q:PROVIEN=""  D
  1.  ... S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_PROVNM
  1.  ... S LNCNT=LNCNT+1
  1.  ... Q
  1.  .. Q
  1.  . S LNCNT=LNCNT-1
  1.  . Q
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="    Source(s): "
  1.  I SRC["T",SRC["C",SRC["O",SRC["X",SRC["E" S TXT(LNCNT)=$G(TXT(LNCNT))_"ALL"
  1.  E  D
  1.  . I SRC["T" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_"T: TIU DOCUMENTS",LNCNT=LNCNT+1
  1.  . I SRC["C" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_"C: REQUEST/CONSULTATIONS",LNCNT=LNCNT+1
  1.  . I SRC["O" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_"O: ORDERS",LNCNT=LNCNT+1
  1.  . I SRC["X" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_"X: OUTSIDE OF CPRS",LNCNT=LNCNT+1
  1.  . I SRC["E" S TXT(LNCNT)=$S($L($G(TXT(LNCNT)))>0:$G(TXT(LNCNT)),1:"               ")_"E: EVERYTHING ELSE"
  1.  . Q
  1.  S LNCNT=LNCNT+1,TXT(LNCNT)="       Device: "_$G(IOST)
  1.  S TXT(LNCNT)=$G(TXT(LNCNT))_$S($G(IO("DOC"))'="":" ("_$G(IO("DOC")),$G(IO("HFSIO"))'="":" ("_$G(IO("HFSIO")),1:"")
  1.  D ^XMD
  1.  Q