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

TIUCOP.m

Go to the documentation of this file. 
  1. TIUCOP ;SLC/TDP - Copy/Paste API(s) and RPC(s) ;Jul 29, 2020@10:13:01
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**290,336**;Jun 20, 1997;Build 4
  1.  ;
  1.  ; External Reference
  1.  ;   DBIA  2051  $$FIND1^DIC
  1.  ;   DBIA  1544  $$ISA^USRLM
  1.  ;
  1.  Q
  1. WORDS(INST) ;Return the number of words required to begin tracking
  1.  ; copied text as part of the Copy/Paste functionality.
  1.  ;
  1.  ;   Call using $$WORDS^TIUCOP(INSTITUTION IEN)
  1.  ;
  1.  ;   Input
  1.  ;     INST - institution ien
  1.  ;
  1.  ;   Ouput
  1.  ;     - Number of Words required (example "5")^Max text length
  1.  ;                Or
  1.  ;       Error condition "-1^Error Msg"
  1.  ;
  1.  N IEN,WRDS,MAXLNG
  1.  I $G(INST)="" S INST=$G(DUZ(2))
  1.  I +INST<1 Q "-1^Invalid institution"
  1.  S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
  1.  I +INST<1 Q "-1^Invalid institution"
  1.  S IEN=$O(^TIU(8925.99,"B",INST,0))
  1.  I +IEN=0 Q "-1^Institution not defined in TIU PARAMETERS file"
  1.  S WRDS=+$P($G(^TIU(8925.99,IEN,4)),U,1)
  1.  I WRDS=0 S WRDS=5 D ERMSG^TIUCOPUT("WORD") ;Send error message if required words not set in parameter
  1.  Q WRDS
  1.  ;
  1. MAXLNG() ;Return the Maximum length string we will recalculate percentage
  1.  N MAX
  1.  S MAX=$$GET^XPAR("ALL","ORQQTIU COPY/PASTE FIND LIMIT",,"Q")
  1.  I MAX="" S MAX=10000
  1.  Q MAX
  1.  ;
  1. PCT(INST) ;Return the Copy/Paste verification percentage
  1.  ;   Call using $$PCT^TIUCOP(INSTITUTION IEN)
  1.  ;
  1.  ;   Input
  1.  ;     INST - institution ien
  1.  ;
  1.  ;   Output
  1.  ;     - Percent pasted text matches copied text needed to be considered
  1.  ;       as derived from the copied text (example ".5")
  1.  ;                Or
  1.  ;       Error condition "-1^Error Msg"
  1.  ;
  1.  N IEN,PCT
  1.  I $G(INST)="" S INST=$G(DUZ(2))
  1.  I +INST<1 Q "-1^Invalid institution"
  1.  S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
  1.  I +INST<1 Q "-1^Invalid institution"
  1.  S IEN=$O(^TIU(8925.99,"B",INST,0))
  1.  I +IEN=0 Q "-1^Institution not defined in TIU PARAMETERS file"
  1.  S PCT=+$P($G(^TIU(8925.99,IEN,4)),U,2)
  1.  I PCT=0 S PCT=90 D ERMSG^TIUCOPUT("PCT") ;Send error message if required percentage is not set in parameter
  1.  Q PCT/100
  1.  ;
  1. DAYS(INST) ;Return the number of days to save copied text information
  1.  ;   Call using $$DAYS^TIUCOP(INSTITUTION IEN)
  1.  ;
  1.  ;   Input
  1.  ;     INST - institution ien
  1.  ;
  1.  ;   Output
  1.  ;     - Days to save copied text (example "7")
  1.  ;                Or
  1.  ;       Error condition "-1^Error Msg"
  1.  ;
  1.  N IEN,DAYS
  1.  I $G(INST)="" S INST=$G(DUZ(2))
  1.  I +INST<1 Q "-1^Invalid institution"
  1.  S INST=$$FIND1^DIC(4,"","","`"_INST,"","","ERR")
  1.  I +INST<1 Q "-1^Invalid institution"
  1.  S IEN=$O(^TIU(8925.99,"B",INST,0))
  1.  I +IEN=0 Q "-1^Institution not defined in TIU PARAMETERS file"
  1.  S DAYS=+$P($G(^TIU(8925.99,IEN,4)),U,3)
  1.  I DAYS=0 S DAYS=1 D ERMSG^TIUCOPUT("DAY") ;Send error message if required percentage is not set in parameter
  1.  Q DAYS
  1.  ;
  1. EXC(TIUDA) ;Return whether or not note is excluded from copy/paste tracking
  1.  ;   Call using $$EXC^TIUCOP(TIU IEN)
  1.  ;
  1.  ;   Input
  1.  ;     TIUDA - TIU ien (#8925)
  1.  ;
  1.  ;   Output
  1.  ;     - Boolean (1: Exclude, 0:Don't Exclude)
  1.  ;                Or
  1.  ;       Error condition "-1^Error Msg"
  1.  ;
  1.  N CLDOC,IEN,EX,ND0,TMP,X
  1.  S EX=0
  1.  I $G(TIUDA)="" Q "-1^TIU IEN required"
  1.  I +TIUDA<1 Q "-1^Invalid TIU IEN"
  1.  I '$G(^TIU(8925,TIUDA,0)) Q "-1^Invalid TIU IEN"
  1.  S IEN=+$P($G(^TIU(8925,TIUDA,0)),U,1)
  1.  I '$D(^TIU(8925.1,IEN,0)) Q EX ;Missing TIU Document Type
  1.  S ND0=$G(^TIU(8925.1,IEN,0))
  1.  I ND0="" Q EX
  1.  S CLDOC=$O(^TIU(8925.1,"B","CLINICAL DOCUMENTS",""))
  1.  D ANCESTOR^TIUFLF4(IEN,ND0,.TMP,0)
  1.  S X=""
  1.  F  S X=$O(TMP(X)) Q:X=""  Q:IEN=CLDOC  D  Q:EX=1
  1.  . S IEN=+$G(TMP(X))
  1.  . I IEN=CLDOC Q
  1.  . S IEN=$O(^TIU(8925.95,"B",IEN,0))
  1.  . I +IEN<1 Q  ;"-1^Missing TIU Document Type"
  1.  . S EX=+$P($G(^TIU(8925.95,IEN,10)),U,1)
  1.  . I EX'="" S IEN=CLDOC
  1.  Q EX
  1.  ;
  1. EXCLST(TIULST) ;Returns a list of all copy/paste excluded note titles
  1.  N CNT,DOCTTL,DOCCLS,DOCIEN,DOCNM,TIUND0
  1.  S (CNT,DOCCLS)=0
  1.  F  S DOCCLS=$O(^TIU(8925.95,"AC",DOCCLS)) Q:DOCCLS=""  D
  1.  . S TIUND0=$G(^TIU(8925.1,DOCCLS,0))
  1.  . ;Track list of documents to return
  1.  . I $P(TIUND0,U,4)="DOC" D
  1.  . . S CNT=CNT+1
  1.  . . S TIULST(CNT)=DOCCLS_U_$P(TIUND0,U,1)
  1.  . . S TIULST("B",DOCCLS)=""
  1.  . ;Track list of non-documents to review further
  1.  . S DOCTTL=0
  1.  . F  S DOCTTL=$O(^TIU(8925.1,"ACL",DOCCLS,DOCTTL)) Q:DOCTTL=""  D
  1.  . . S DOCIEN=0
  1.  . . F  S DOCIEN=$O(^TIU(8925.1,"ACL",DOCCLS,DOCTTL,DOCIEN)) Q:DOCIEN=""  D
  1.  . . . S DOCNM=$P($G(^TIU(8925.1,DOCIEN,0)),U,1)
  1.  . . . I '$D(TIULST("B",DOCIEN)) S CNT=CNT+1,TIULST(CNT)=DOCIEN_U_DOCNM,TIULST("B",DOCIEN)=""
  1.  I CNT=0 S TIULST(1)=""
  1.  K TIULST("B")
  1.  Q
  1.  ;
  1. VIEW(USER,IEN,INST) ;Is user allowed to view copy/paste
  1.  ;   Call using $$VIEW^TIUCOP(USER DUZ,TIU (NOTE) IEN,INSTITUTION)
  1.  ;   RSLT=
  1.  ;      0 - User is not allowed to view copy/paste information
  1.  ;      1 - User is AUTHOR and note is UNSIGNED, or user is COSIGNER who has yet to
  1.  ;          SIGN the note.
  1.  ;      2 - User has a user class of "CHIEF, MIS", or "CHIEF, HIMS",
  1.  ;          or "PRIVACY ACT OFFICER", or one of the user classes designated
  1.  ;          at the site.
  1.  N AUTH,AUTHSGN,CHIM,CMIS,COSGNSGN,COSIGN,FIN,HIM,INSTIEN,PAO,TIU12,TIU15
  1.  N USRCLS,X
  1.  S FIN=""
  1.  I +USER=0 Q 0 ;Not a valid user, so not allowed to view
  1.  S INST=$G(DUZ(2))
  1.  I +INST=0 Q 0 ;Institution is required
  1.  S CMIS="CHIEF, MIS"
  1.  S CHIM="CHIEF, HIMS"
  1.  S PAO="PRIVACY ACT OFFICER"
  1.  F USRCLS=CHIM,CMIS,PAO D  Q:FIN
  1.  . S FIN=$$ISA^USRLM(+USER,USRCLS)
  1.  I FIN Q 2 ;User belongs to special user class
  1.  S INSTIEN=$O(^TIU(8925.99,"B",INST,""))
  1.  I INSTIEN>0 S X=0 F  S X=$O(^TIU(8925.99,INSTIEN,5,X)) Q:+X=0  D  Q:FIN
  1.  . S USRCLS=$P(^TIU(8925.99,INSTIEN,5,X,0),U,1)
  1.  . S FIN=$$ISA^USRLM(+USER,USRCLS)
  1.  I FIN Q 2 ;User belongs to special user class
  1.  I +$G(IEN)=0 Q 0 ;No ien.  User does not belong to special user class and no further checks.
  1.  S TIU12=$G(^TIU(8925,+IEN,12))
  1.  S TIU15=$G(^TIU(8925,+IEN,15))
  1.  S AUTH=+$P(TIU12,U,2)
  1.  S AUTHSGN=+$P(TIU15,U,2)
  1.  ;I AUTH=USER,AUTH'=AUTHSGN Q 1 ;User is author and has not signed note.
  1.  I AUTH=USER,AUTHSGN=0 Q 1 ;User is author and has not signed note.
  1.  S COSIGN=+$P(TIU12,U,8)
  1.  I 'COSIGN Q 0 ;No cosigner, so user not authorized.
  1.  S COSGNSGN=+$P(TIU15,U,8)
  1.  I COSIGN=USER,COSIGN'=COSGNSGN Q 1 ;User is cosigner and unsigned, author has signed.
  1.  Q 0 ;User not authorized
  1.  ;
  1. PUTCOPY(INST,ARY,ERR) ;Save to copy buffer
  1.  N SAVE
  1.  S INST=$G(DUZ(2))
  1.  S SAVE=$$PUTCOPY^TIUCOPC(INST,.ARY,.ERR)
  1.  Q SAVE
  1.  ;
  1. GETCOPY(INST,DFN,ARY,STRT) ;Retrieve copy buffer
  1.  I $G(STRT)="" S STRT=""
  1.  S INST=$G(DUZ(2))
  1.  D GETCOPY^TIUCOPC(INST,DFN,.ARY,STRT,1)
  1.  Q
  1.  ;
  1. GETCOPY1 ;Retrieve copy buffer in background
  1.  ;DFN,DIV,HWND,IP,NODE are saved variables as part of queued process
  1.  ;ZTQUEUED,ZTREQ are variables that exist as part of a queued process
  1.  ;DILOCKTM is a global variable
  1.  N ARY,STRT
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE) Q  ; client no longer polling
  1.  I '$D(^XTMP(NODE,0)) Q                    ; XTMP node has been purged
  1.  L +^XTMP(NODE):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
  1.  S ^XTMP(NODE,"DFN")=DFN
  1.  S (ARY,STRT)=""
  1.  D GETCOPY^TIUCOPC(DIV,DFN,.ARY,STRT,0)
  1.  I $G(^XTMP(NODE,"STOP")) Q
  1.  I +ARY(0,0)>0 D
  1.  . N CNT,ND,ND1,X
  1.  . S CNT=0
  1.  . S ND="" F  S ND=$O(ARY(ND)) Q:ND=""  D
  1.  .. S ND1="" F  S ND1=$O(ARY(ND,ND1)) Q:ND1=""  D
  1.  ... I ND=0,ND1=0 Q
  1.  ... S X="("_ND_","_ND1_")="
  1.  ... S CNT=CNT+1
  1.  ... S ^XTMP(NODE,"COPY",CNT)=X_$G(ARY(ND,ND1))
  1.  ... K ARY(ND,ND1)
  1.  ;... I (CNT#100)=0 H 10
  1.  I +$G(ARY(0,0))=-1 S ^XTMP(NODE,"COPY",-1)=$P($G(ARY),U,2) K ARY(0,0)
  1.  S ^XTMP(NODE,"DONE")=1
  1.  I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE)
  1.  L -^XTMP(NODE)
  1.  Q
  1. CHKPASTE(INST,DOC) ;Check note document for pasted text data
  1.  S INST=$G(DUZ(2))
  1.  Q $$CHKPASTE^TIUCOPP(DOC,INST)
  1.  ;
  1. PUTPASTE(RSLT,INST,ARY,ERR) ;Save pasted text SVARY
  1.  N CNTR,DIV,PIEN,RSLT1,SAVE,SVARY
  1.  S INST=$G(DUZ(2))
  1.  S SAVE=""
  1.  S SVARY=1
  1.  S SAVE=$$PUTPASTE^TIUCOPP(INST,.ARY,.ERR,.SVARY)
  1.  I +$G(SVARY(0))>0 S CNTR=0 F  S CNTR=$O(SVARY(CNTR)) Q:CNTR=""  D
  1.  . S DIV=+$G(SVARY(CNTR)) Q:DIV=0
  1.  . S PIEN=$P($G(SVARY(CNTR)),U,2)
  1.  . D GETPST^TIUCOP1(PIEN,DIV,.RSLT1,1)
  1.  I +$G(RSLT1(0,0))=-1 S RSLT(-1)=$P($G(RSLT1),U,2) S RSLT("0,0")=-1 K RSLT1(0,0) Q 0
  1.  I +$G(RSLT1(0,0))>0 D
  1.  . N CNT,ND,ND1
  1.  . S CNT=0
  1.  . S ND=0 F  S ND=$O(RSLT1(ND)) Q:ND=""  D
  1.  .. S CNT=CNT+1
  1.  .. S RSLT(CNT)=CNT_"="_$G(RSLT1(ND,0))
  1.  .. K RSLT1(ND)
  1.  Q SAVE
  1.  ;
  1. GETPASTE(TIUIEN,INST,APP,ARY) ;Retrieve pasted text
  1.  S INST=$G(DUZ(2))
  1.  D GETPASTE^TIUCOPP(TIUIEN,INST,APP,.ARY,0)
  1.  Q
  1.  ;
  1. START(VAL,DFN,IP,HWND,DIV) ;Start copy buffer build in background
  1.  N DT,NODE,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK ;,ORHTIME
  1.  S DIV=$G(DUZ(2))
  1.  S VAL=0
  1.  S DT=$$DT^XLFDT
  1.  S NODE="TIUCOP "_IP_"-"_HWND_"-"_DFN
  1.  S ZTIO="",ZTRTN="GETCOPY1^TIUCOP",ZTDTH=$H
  1.  S (ZTSAVE("DFN"),ZTSAVE("IP"),ZTSAVE("HWND"),ZTSAVE("DIV"),ZTSAVE("NODE"))=""
  1.  S ZTDESC="CPRS GUI Background Data Retrieval"
  1.  K ^XTMP(NODE)
  1.  S ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT
  1.  D ^%ZTLOAD I '$D(ZTSK) D  Q
  1.  . K ^XTMP(NODE,0)
  1.  . S VAL=0
  1.  S $P(^XTMP(NODE,0),U,3)="Background CPRS "_ZTSK
  1.  S VAL=1
  1.  ; Start capacity planning timing clock - will be stopped in POLL code
  1.  ;I +$G(^KMPTMP("KMPD-CPRS")) S ^KMPTMP("KMPDT","ORWCV",NODE)=$G(ORHTIME)_"^^"_$G(DUZ)_"^"_$G(IO("CLNM"))
  1.  Q
  1.  ;
  1. POLL(LST,DFN,IP,HWND) ; poll for completed cover sheet parts
  1.  N I,ILST,ID,LAST,LSTDATA,NODE,DONE,STOP,OLDI,QT
  1.  S NODE="TIUCOP "_IP_"-"_HWND_"-"_DFN,ILST=1,DONE=0
  1.  I '$D(^XTMP(NODE,"DFN")) S LST(1)="~DONE=1" Q
  1.  I ^XTMP(NODE,"DFN")'=DFN S LST(1)="~DONE=1" Q
  1.  S LST(1)="~DONE=0"
  1.  I $G(^XTMP(NODE,"DONE")) S ILST=1,LST(1)="~DONE=1",DONE=1
  1.  S LAST=$O(^XTMP(NODE,"COPY",""),-1)
  1.  ;I LAST="" S LST(1)="~NO DATA YET" Q
  1.  S STOP=99999999999
  1.  I $G(LAST)'="" D
  1.  . ;S STOP=($P($P($G(^XTMP(NODE,"COPY",LAST)),",",1),"(",2)-1)
  1.  . S STOP=$P($P($G(^XTMP(NODE,"COPY",LAST)),",",1),"(",2)
  1.  . I STOP<1 S STOP=0
  1.  S (OLDI,QT)=0
  1.  S I=0 F  S I=$O(^XTMP(NODE,"COPY",I)) Q:'I  D  Q:QT=1
  1.  . I $G(^XTMP(NODE,"STOP"))=1 S (DONE,QT)=1,LST(1)="~DONE=1"
  1.  . I $P($P($G(^XTMP(NODE,"COPY",I)),",",1),"(",2)>STOP S QT=1 Q
  1.  . ;I ILST=1999!ILST-1=LAST S OLDI=($P($P($G(^XTMP(NODE,"COPY",I)),",",1),"(",2)-1)
  1.  . ;I ((ILST>1999)!(LAST'<ILST)),OLDI'=($P($P($G(^XTMP(NODE,"COPY",I)),",",1),"(",2)-1) S QT=1 Q
  1.  . S ILST=ILST+1,LST(ILST)=^(I)
  1.  . I ILST=2000 S QT=1
  1.  . K ^XTMP(NODE,"COPY",I)
  1.  I 'DONE,$G(^XTMP(NODE,"STOP"))=1 S DONE=1,LST(1)="~DONE=1"
  1.  ; Stop capacity planning timing clock - was started in START code
  1.  I DONE K ^XTMP(NODE) Q  ;I +$G(^KMPTMP("KMPD-CPRS")) S $P(^KMPTMP("KMPDT","ORWCV",NODE),"^",2)=$H
  1.  I $G(LST(1))="" S LST(1)="~NO DATA YET"
  1.  Q
  1.  ;
  1. STOP(OK,DFN,IP,HWND) ; stop cover sheet data retrieval
  1.  ;DILOCKTM is a global variable
  1.  N NODE
  1.  S NODE="TIUCOP "_IP_"-"_HWND_"-"_DFN
  1.  S ^XTMP(NODE,"STOP")=1,OK=1
  1.  L +^XTMP(NODE):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
  1.  I $G(^XTMP(NODE,"DONE")) K ^XTMP(NODE)
  1.  L -^XTMP(NODE)
  1.  Q
  1.  ;
  1. CLEAN(TASK) ;Start CLEANUP background process
  1.  N DT,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  S TASK=0
  1.  S DT=$$DT^XLFDT
  1.  S ZTIO="",ZTRTN="CLEANUP^TIUCOP",ZTDTH=$H
  1.  S ZTDESC="TIU Copy/Paste Background ^XTMP global clean-up"
  1.  D ^%ZTLOAD I '$D(ZTSK) Q Y
  1.  S TASK=ZTSK
  1.  Q
  1.  ;
  1. CLEANUP ; clean up ^XTMP nodes
  1.  N %Y,DT,KILLDATE,NODE,TIUNMSPC,X,X1,X2
  1.  S DT=$$DT^XLFDT ;Get current date
  1.  ;Loop through Copy Buffer polling (retrieval) nodes
  1.  S NODE="TIUCOP"
  1.  F  S NODE=$O(^XTMP(NODE)) Q:$E(NODE,1,6)'="TIUCOP"  D
  1.  . S (%Y,KILLDATE,X,X1,X2)=""
  1.  . S X1=DT
  1.  . S X2=$P($G(^XTMP(NODE,0)),U,1)
  1.  . D ^%DTC
  1.  . I +X>1 K ^XTMP(NODE)
  1.  ;. W !,X K ^XTMP(NODE)
  1.  ;Loop through Copy Buffer save nodes
  1.  S TIUNMSPC="TIU COPY/PASTE:"
  1.  F  S TIUNMSPC=$O(^XTMP(TIUNMSPC)) Q:TIUNMSPC=""!(TIUNMSPC'["TIU COPY/PASTE:")  D
  1.  . S (%Y,KILLDATE,X,X1,X2)=""
  1.  . S X1=DT
  1.  . S X2=$P($G(^XTMP(TIUNMSPC,0)),U,1)
  1.  . D ^%DTC
  1.  . ;Kill off entry if 2 days past its expiration date
  1.  . I +X>1 K ^XTMP(TIUNMSPC)
  1.  Q
  1.  ;
  1. DELPST(NOTE) ;Delete pastes associated with a deleted note
  1.  N DA,DIK
  1.  S DIK="^TIUP(8928,"
  1.  S DA=""
  1.  F  S DA=$O(^TIUP(8928,"AD",8925,NOTE,DA)) Q:DA=""  D
  1.  . D ^DIK
  1.  Q
  1.  ;