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

TIUSRVLO.m

Go to the documentation of this file.
  1. TIUSRVLO ;SLC/JER - Server fns - lists for CPRS ;Apr 06, 2021@11:27:34
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,194,211,268,287,339**;Jun 20, 1997;Build 39
  1. ;
  1. ; AWCMCPR1 DBIA #4325
  1. ;
  1. NOTES(TIUY,DFN,EARLY,LATE,PERSON,SEQUENCE) ; Get notes
  1. N TIUPREF,TIUOCC S TIUPREF=$$PERSPRF^TIULE(DUZ)
  1. S TIUOCC=$P(TIUPREF,U,10),PERSON=$S(+$G(PERSON):+$G(PERSON),1:+$G(DUZ))
  1. S SEQUENCE=$S($G(SEQUENCE)]"":$G(SEQUENCE),1:"D")
  1. D CONTEXT(.TIUY,3,1,DFN,$G(EARLY),$G(LATE),PERSON,TIUOCC,SEQUENCE)
  1. Q
  1. SUMMARY(TIUY,DFN,EARLY,LATE) ; Get Summaries
  1. N TIUPREF,TIUOCC S TIUPREF=$$PERSPRF^TIULE(DUZ)
  1. S TIUOCC=$P(TIUPREF,U,10),PERSON=$S(+$G(PERSON):+$G(PERSON),1:+$G(DUZ))
  1. S SEQUENCE=$S($G(SEQUENCE)]"":$G(SEQUENCE),1:"D")
  1. D CONTEXT(.TIUY,244,1,DFN,$G(EARLY),$G(LATE),PERSON,TIUOCC,SEQUENCE)
  1. Q
  1. CONTEXT(TIUY,CLASS,CONTEXT,DFN,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND,SHOW,TIUIEN) ; main
  1. ; --- Call with: TIUY - RETURN ARRAY pass by reference
  1. ; CLASS - Pointer to TIU DOCUMENT DEFINITION #8925.1
  1. ; CONTEXT - 1=All Signed (by PT),
  1. ; - 2="Unsigned (by PT&(AUTHOR!TANSCRIBER))
  1. ; - 3="Uncosigned (by PT&EXPECTED COSIGNER
  1. ; - 4="Signed notes (by PT&selected author)
  1. ; - 5="Signed notes (by PT&date range)
  1. ; DFN - Pointer to Patient (#2)
  1. ; [EARLY] - FM date/time to begin search
  1. ; [LATE] - FM date/time to end search
  1. ; [PERSON] - Pointer to file 200 (DUZ if not passed)
  1. ; [OCCLIM] - Occurrence Limit (optional)
  1. ; [SEQUENCE]- "A"=ascending (Regular date/time)
  1. ; - "D"=descending (Reverse date/time) (dflt)
  1. ; [INCUND] - Boolean: include undictated & untranscribed
  1. ; SHOW - Boolean: Return "0^SHOW MORE" in return
  1. ; array when additional notes available for
  1. ; context of 1 or 5 when occurrence limit
  1. ; prevents all notes from displaying
  1. ; TIUIEN - Starting TIU IEN for additional return
  1. ; when "SHOW MORE" was received in previous
  1. ; return array (LATE date/time will be set
  1. ; to Reference date of this TIU document)
  1. ;
  1. S TIUY=$NA(^TMP("TIUR",$J))
  1. K @TIUY
  1. I $G(CONTEXT)'>0 Q
  1. I $G(CLASS)'>0 Q
  1. I $G(CONTEXT)=1 D STRT1^AWCMCPR1 ; TIU*1.0*181
  1. S:+$G(EARLY)'>0!(+$G(CONTEXT)=1) EARLY=0
  1. S:+$G(LATE)'>0!(+$G(CONTEXT)=1) LATE=5000000
  1. I EARLY>LATE D SWAP(.EARLY,.LATE)
  1. I +$G(TIUIEN)>0,(CONTEXT=1!(CONTEXT=5)) S LATE=$P($G(^TIU(8925,+TIUIEN,13)),U,1) I EARLY>LATE Q
  1. I $L(LATE,".")=1 D EXPRANGE(.EARLY,.LATE)
  1. S:+$G(PERSON)'>0 PERSON=DUZ
  1. S:$G(SEQUENCE)']"" SEQUENCE="D"
  1. S:+$G(OCCLIM)'>0 OCCLIM=9999999
  1. S DFN=+$G(DFN)
  1. S EARLY=9999999-EARLY,LATE=9999999-LATE ; CHANGE TO REVERSE DATES
  1. ;
  1. I CONTEXT=1!(CONTEXT=5) D G CTXQ
  1. . D ACLPT(.TIUY,CLASS,DFN,LATE,EARLY,OCCLIM,SEQUENCE,+$G(SHOW),$G(TIUIEN))
  1. ;
  1. I CONTEXT=2 D G CTXQ
  1. . I DFN>0 D Q
  1. . . D ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$G(INCUND))
  1. . F S DFN=$O(^TIU(8925,"ACLAU",CLASS,PERSON,DFN)) Q:DFN'>0 D ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$G(INCUND))
  1. ;
  1. I CONTEXT=3 D G CTXQ
  1. . I DFN>0 D Q
  1. . . D ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
  1. . F S DFN=$O(^TIU(8925,"ACLEC",CLASS,PERSON,DFN)) Q:DFN'>0 D ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
  1. ;
  1. I CONTEXT=4 D G CTXQ
  1. . I DFN>0 D Q
  1. . . D APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
  1. . F S DFN=$O(^TIU(8925,"APTCL",DFN)) Q:DFN'>0 D APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
  1. ;
  1. CTXQ ;
  1. K @TIUY@("INDX")
  1. I $D(AWCSTRT) D END^AWCMCPR1 ; TIU*1.0*181
  1. Q
  1. ;
  1. SWAP(TIUX,TIUY) ; Swap variables
  1. N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP
  1. Q
  1. ;
  1. EXPRANGE(TIUX,TIUY) ; Expand range when same for early & late
  1. I TIUX=DT S TIUY=$$NOW^XLFDT I 1
  1. E S TIUY=TIUY_"."_2359
  1. Q
  1. ;
  1. ACLPT(TIUY,CLASS,DFN,TIME1,TIME2,OCCLIM,SEQUENCE,SHOW,TIUIEN) ; Signed, by patient
  1. N DATTIM,DA,LSTDA,NGD,PRVRTNDT,ROOT,STRTDT,TIUI,TIUJ,TIUP,OCCLIM2
  1. S (LSTDA,NGD,STRTDT)=0
  1. I +TIUIEN>0 D
  1. . S NGD=1
  1. . S STRTDT=9999999-TIME1
  1. . S PRVRTNDT=0
  1. S OCCLIM2=OCCLIM,OCCLIM=OCCLIM+1
  1. S ROOT=$NA(^TIU(8925,"ACLPT",CLASS,DFN)),TIUJ=0
  1. S DATTIM=TIME1-.0000001
  1. F S DATTIM=$O(@ROOT@(DATTIM)) Q:$S(+DATTIM'>0:1,+DATTIM>TIME2:1,+$G(TIUJ)'<OCCLIM:1,1:0) D Q:+$G(TIUJ)'<OCCLIM
  1. . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 Q:+$G(TIUJ)'<OCCLIM D
  1. . . I NGD=1 D Q ;If grabbing additional entries, don't return any before the one sent in or the sent in one as the starting point
  1. . . . I DA=TIUIEN D ;Reached starting point, everything after is valid to return
  1. . . . . S NGD=0
  1. . . . . S PRVRTNDT=9999999-DATTIM
  1. . . . . Q
  1. . . . Q
  1. . . ;Added first condition to following line for interdisciplinary notes - need addenda
  1. . . I +$G(SHOWADD)=0,(+$G(^TIU(8925,+DA,0))=81) Q
  1. . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
  1. . . ; Selectively filter DELETED or RETRACTED records
  1. . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
  1. . . I +$D(@TIUY@("INDX",DA)) S LSTDA=DA Q
  1. . . I TIUJ'<OCCLIM2 S OCCLIM=OCCLIM2 Q
  1. . . S LSTDA=DA
  1. . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
  1. . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
  1. . . I '+$D(@TIUY@("INDX",+$P($G(^TIU(8925,+DA,0)),U,6))),'+$D(@TIUY@("INDX",+$G(^TIU(8925,+DA,21)))) S TIUJ=+$G(TIUJ)+1
  1. . . S @TIUY@("INDX",DA,TIUI)=""
  1. . . Q:+$G(SHOWADD)=0
  1. . . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,1)
  1. . . . N TIUPT
  1. . . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
  1. . . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
  1. . . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
  1. . . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=1 Q
  1. . . I +$$HASKIDS^TIUSRVLI(DA) D
  1. . . . ;ADD IF PREVIOUS RETURN THEN REMOVE ENTRY CODE
  1. . . . D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,1)
  1. I +TIUIEN>0 D RESEQ^TIUSRVLI(.TIUY,.TIUI)
  1. I +SHOW>0,+DATTIM>0,+DATTIM'>TIME2,+$G(TIUJ)'<OCCLIM D
  1. . S DA=LSTDA ;+$G(@TIUY@(TIUI))
  1. . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
  1. . N LSTDT S LSTDT=+$G(^TIU(8925,+DA,13)) I LSTDT'>0 S LSTDT=""
  1. . S @TIUY@(TIUI)=DA_"^SHOW MORE^"_LSTDT_"^^^^^^^^^^^"_$S(+$G(CONTEXT):CONTEXT,1:1)_"^"
  1. Q
  1. ;
  1. ACLAU(TIUY,CLASS,AUTHOR,DFN,TIME1,TIME2,SEQUENCE,INCUND) ; Unsigned
  1. N DATTIM,DA,ROOT,TIUI
  1. S ROOT=$NA(^TIU(8925,"ACLAU",CLASS,AUTHOR,DFN))
  1. S DATTIM=TIME1-.0000001
  1. F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
  1. . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
  1. . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
  1. . . I +$P($G(^TIU(8925,DA,0)),U,5)>6 K @ROOT@(DATTIM,DA) Q
  1. . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
  1. . . Q:+$D(@TIUY@("INDX",DA))
  1. . . ; Selectively filter DELETED or RETRACTED records
  1. . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
  1. . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
  1. . . S @TIUY@("INDX",DA,TIUI)=""
  1. . . Q:+$G(SHOWADD)=0
  1. . . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
  1. . . . N TIUPT
  1. . . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
  1. . . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
  1. . . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
  1. . . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=2 Q
  1. . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
  1. I +$G(INCUND) D GETUND^TIUSRVLI(.TIUY,CLASS,DFN,TIME1,TIME2,.TIUI,SEQUENCE)
  1. Q
  1. ;
  1. ACLEC(TIUY,CLASS,EXCOSIGN,DFN,TIME1,TIME2,SEQUENCE) ; Uncosigned
  1. N DATTIM,DA,ROOT,TIUI
  1. S ROOT=$NA(^TIU(8925,"ACLEC",CLASS,EXCOSIGN,DFN))
  1. S DATTIM=TIME1-.0000001
  1. F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
  1. . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
  1. . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
  1. . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
  1. . . Q:+$D(@TIUY@("INDX",DA))
  1. . . ; Selectively filter DELETED or RETRACTED records
  1. . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
  1. . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
  1. . . S @TIUY@("INDX",DA,TIUI)=""
  1. . . Q:+$G(SHOWADD)=0
  1. . . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
  1. . . . N TIUPT
  1. . . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
  1. . . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
  1. . . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
  1. . . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=3 Q
  1. . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
  1. Q
  1. ;
  1. ACLSB(TIUY,CLASS,SIGNEDBY,DFN,TIME1,TIME2,SEQUENCE) ; Signed, by author
  1. N DATTIM,DA,ROOT,TIUI
  1. S ROOT=$NA(^TIU(8925,"ACLSB",CLASS,SIGNEDBY,DFN))
  1. S DATTIM=TIME1-.0000001
  1. F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
  1. . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
  1. . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
  1. . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
  1. . . Q:+$D(@TIUY@("INDX",DA))
  1. . . ; Selectively filter DELETED or RETRACTED records
  1. . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
  1. . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
  1. . . S @TIUY@("INDX",DA,TIUI)=""
  1. . . Q:+$G(SHOWADD)=0
  1. . . I +$$HASDAD^TIUSRVLI(DA) D
  1. . . . S TIUP=+$$HASDAD^TIUSRVLI(DA) I TIUP D D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI,0)
  1. . . . N TIUPT
  1. . . . S TIUPT=$P($G(^TIU(8925,+DA,0)),"^",6)
  1. . . . I TIUPT]"",'$D(^TIU(8925,"DAD",TIUPT,DA)) S ^TIU(8925,"DAD",TIUPT,DA)=""
  1. . . . I TIUPT="" S TIUPT=$G(^TIU(8925,+DA,21))
  1. . . . I '$D(^TIU(8925,TIUPT,0)) S $P(@TIUY@(TIUI),"^",16)=1,$P(@TIUY@(TIUI),"^",14)=1 Q
  1. . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI,0)
  1. Q
  1. ;
  1. RESOLVE(DA) ; Resolve to external data
  1. N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13,TIUR14
  1. N TIUR17,STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT,PREFIX,IDPARENT,IDSORT
  1. S PREFIX=""
  1. S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
  1. S TIUR13=$G(^TIU(8925,+DA,13)),TIUR14=$G(^(14)),TIUR17=$G(^(17))
  1. S IDPARENT=+$G(^TIU(8925,+DA,21))
  1. S TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))
  1. S DOC=$TR($$PNAME^TIULC1(+TIUR0),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. S DOC=$$PNAME^TIULC1(+TIUR0)
  1. I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
  1. ;
  1. ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
  1. ; which prefix to use:
  1. ; - keep prefix display in earlier CPRS versions and LM
  1. ; - omit in newer TreeView versions
  1. I $L($T(PREFIX^TIULA2)) D I 1
  1. . S PREFIX=$$PREFIX^TIULA2(DA,1) ; 1=include ID Child indicator
  1. . I PREFIX["<" S IDSORT=$$IDSORT(DA)
  1. . I +$G(SHOWADD)=0 S DOC=PREFIX_DOC
  1. ; otherwise, only show addendum indicator (+)
  1. ; - keep prefix display in earlier CPRS versions and LM
  1. ; - omit in newer TreeView versions
  1. E D
  1. . I +$$HASADDEN^TIULC1(DA) S PREFIX="+ "
  1. . I +$G(SHOWADD)=0,(+$$HASADDEN^TIULC1(DA)) S DOC=PREFIX_DOC
  1. I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC
  1. S STATUS=$$LOWER^TIULS($P($G(^TIU(8925.6,+$P(TIUR0,U,5),0)),U))
  1. S LOC=$G(^SC(+$P(TIUR12,U,5),0)),LOCTYP=$P(LOC,U,3),LOC=$P(LOC,U)
  1. S TIUADT=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($P(TIUR0,U,7),"MM/DD/YY")
  1. S TIUDDT=$S(+$P(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($P(TIUR0,U,8),"MM/DD/YY")
  1. I +$G(SHOWADD)>0 S TIUADT=TIUADT_";"_$P(TIUR0,U,7),TIUDDT=TIUDDT_";"_$P(TIUR0,U,8)
  1. S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")
  1. S TIULST4=$E($P(TIUPT,U,9),6,9)
  1. S TIULST4="("_$E(PT)_TIULST4_")"
  1. S AUT=+$P(TIUR12,U,2)
  1. S AUT=AUT_";"_$$SIGNAME^TIULS(+$P(TIUR12,U,2))_";"_$$GET1^DIQ(200,AUT,.01)
  1. S EDT=+TIUR13,EDTCNT=+$G(EDTCNT)+1
  1. S TIUREC=DOC_U_EDT_U_PT_" "_TIULST4_U_AUT_U_LOC_U_STATUS_U_TIUADT_U_TIUDDT_U_$P(TIUR14,U,5)_U_$$IMGCNT(DA)_U
  1. S TIUREC=TIUREC_$S($L(TIUR17):$E(TIUR17,1,(255-$L(TIUREC)))_U,1:U)
  1. S TIUREC=TIUREC_$P(PREFIX," ")_U
  1. S TIUREC=TIUREC_$S(+TIUR0=81:+$P(TIUR0,U,6),+IDPARENT:IDPARENT,+$G(CONTEXT):CONTEXT,1:1)_U_$G(IDSORT)
  1. Q $G(TIUREC)
  1. IMGCNT(TIUDA) ; Get the number of images associated with a document
  1. N IMGDA,TIUI S (IMGDA,TIUI)=0
  1. F S IMGDA=$O(^TIU(8925.91,"ADI",TIUDA,IMGDA)) Q:+IMGDA'>0 D
  1. . S TIUI=TIUI+1
  1. Q TIUI
  1. IDSORT(TIUDA) ; Get ID Sort indicator when appropriate
  1. N TIUDPRM
  1. D DOCPRM^TIULC1(+$G(^TIU(8925,+TIUDA,0)),.TIUDPRM)
  1. Q +$P(TIUDPRM(0),U,18)