[613] | 1 | TIUSRVLO ; SLC/JER - Server fns - lists for CPRS ;9/12/06 14:17
|
---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,194,211**;Jun 20, 1997;Build 26
|
---|
| 3 | NOTES(TIUY,DFN,EARLY,LATE,PERSON,SEQUENCE) ; Get notes
|
---|
| 4 | N TIUPREF,TIUOCC S TIUPREF=$$PERSPRF^TIULE(DUZ)
|
---|
| 5 | S TIUOCC=$P(TIUPREF,U,10),PERSON=$S(+$G(PERSON):+$G(PERSON),1:+$G(DUZ))
|
---|
| 6 | S SEQUENCE=$S($G(SEQUENCE)]"":$G(SEQUENCE),1:"D")
|
---|
| 7 | D CONTEXT(.TIUY,3,1,DFN,$G(EARLY),$G(LATE),PERSON,TIUOCC,SEQUENCE)
|
---|
| 8 | Q
|
---|
| 9 | SUMMARY(TIUY,DFN,EARLY,LATE) ; Get Summaries
|
---|
| 10 | N TIUPREF,TIUOCC S TIUPREF=$$PERSPRF^TIULE(DUZ)
|
---|
| 11 | S TIUOCC=$P(TIUPREF,U,10),PERSON=$S(+$G(PERSON):+$G(PERSON),1:+$G(DUZ))
|
---|
| 12 | S SEQUENCE=$S($G(SEQUENCE)]"":$G(SEQUENCE),1:"D")
|
---|
| 13 | D CONTEXT(.TIUY,244,1,DFN,$G(EARLY),$G(LATE),PERSON,TIUOCC,SEQUENCE)
|
---|
| 14 | Q
|
---|
| 15 | CONTEXT(TIUY,CLASS,CONTEXT,DFN,EARLY,LATE,PERSON,OCCLIM,SEQUENCE,SHOWADD,INCUND) ; main
|
---|
| 16 | ; --- Call with: TIUY - RETURN ARRAY pass by reference
|
---|
| 17 | ; CLASS - Pointer to TIU DOCUMENT DEFINITION #8925.1
|
---|
| 18 | ; CONTEXT - 1=All Signed (by PT),
|
---|
| 19 | ; - 2="Unsigned (by PT&(AUTHOR!TANSCRIBER))
|
---|
| 20 | ; - 3="Uncosigned (by PT&EXPECTED COSIGNER
|
---|
| 21 | ; - 4="Signed notes (by PT&selected author)
|
---|
| 22 | ; - 5="Signed notes (by PT&date range)
|
---|
| 23 | ; DFN - Pointer to Patient (#2)
|
---|
| 24 | ; [EARLY] - FM date/time to begin search
|
---|
| 25 | ; [LATE] - FM date/time to end search
|
---|
| 26 | ; [PERSON] - Pointer to file 200 (DUZ if not passed)
|
---|
| 27 | ; [OCCLIM] - Occurrence Limit (optional)
|
---|
| 28 | ; [SEQUENCE]- "A"=ascending (Regular date/time)
|
---|
| 29 | ; - "D"=descending (Reverse date/time) (dflt)
|
---|
| 30 | ; [INCUND] - Boolean: include undictated & untranscribed
|
---|
| 31 | S TIUY=$NA(^TMP("TIUR",$J))
|
---|
| 32 | K @TIUY
|
---|
| 33 | I $G(CONTEXT)'>0 Q
|
---|
| 34 | I $G(CLASS)'>0 Q
|
---|
| 35 | I $G(CONTEXT)=1 D STRT1^AWCMCPR1 ; TIU*1.0*181
|
---|
| 36 | S:+$G(EARLY)'>0!(+$G(CONTEXT)=1) EARLY=0
|
---|
| 37 | S:+$G(LATE)'>0!(+$G(CONTEXT)=1) LATE=5000000
|
---|
| 38 | I EARLY>LATE D SWAP(.EARLY,.LATE)
|
---|
| 39 | I $L(LATE,".")=1 D EXPRANGE(.EARLY,.LATE)
|
---|
| 40 | S:+$G(PERSON)'>0 PERSON=DUZ
|
---|
| 41 | S:$G(SEQUENCE)']"" SEQUENCE="D"
|
---|
| 42 | S:+$G(OCCLIM)'>0 OCCLIM=9999999
|
---|
| 43 | S DFN=+$G(DFN)
|
---|
| 44 | S EARLY=9999999-EARLY,LATE=9999999-LATE ; CHANGE TO REVERSE DATES
|
---|
| 45 | ;
|
---|
| 46 | I CONTEXT=1!(CONTEXT=5) D G CTXQ
|
---|
| 47 | . D ACLPT(.TIUY,CLASS,DFN,LATE,EARLY,OCCLIM,SEQUENCE)
|
---|
| 48 | ;
|
---|
| 49 | I CONTEXT=2 D G CTXQ
|
---|
| 50 | . I DFN>0 D Q
|
---|
| 51 | . . D ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$G(INCUND))
|
---|
| 52 | . F S DFN=$O(^TIU(8925,"ACLAU",CLASS,PERSON,DFN)) Q:DFN'>0 D ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$G(INCUND))
|
---|
| 53 | ;
|
---|
| 54 | I CONTEXT=3 D G CTXQ
|
---|
| 55 | . I DFN>0 D Q
|
---|
| 56 | . . D ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
|
---|
| 57 | . F S DFN=$O(^TIU(8925,"ACLEC",CLASS,PERSON,DFN)) Q:DFN'>0 D ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
|
---|
| 58 | ;
|
---|
| 59 | I CONTEXT=4 D G CTXQ
|
---|
| 60 | . I DFN>0 D Q
|
---|
| 61 | . . ;VMP OIFO BAY PINES;ELR;TIU*1.0*194 REMOVED EXECUTION OF ACLSB & ADDED APTCL
|
---|
| 62 | . . ;D ACLSB(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
|
---|
| 63 | . . D APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
|
---|
| 64 | . F S DFN=$O(^TIU(8925,"APTCL",DFN)) Q:DFN'>0 D APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
|
---|
| 65 | ;
|
---|
| 66 | CTXQ K @TIUY@("INDX")
|
---|
| 67 | I $D(AWCSTRT) D END^AWCMCPR1 ; TIU*1.0*181
|
---|
| 68 | Q
|
---|
| 69 | ;
|
---|
| 70 | SWAP(TIUX,TIUY) ; Swap variables
|
---|
| 71 | N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP
|
---|
| 72 | Q
|
---|
| 73 | ;
|
---|
| 74 | EXPRANGE(TIUX,TIUY) ; Expand range when same for early & late
|
---|
| 75 | I TIUX=DT S TIUY=$$NOW^XLFDT I 1
|
---|
| 76 | E S TIUY=TIUY_"."_2359
|
---|
| 77 | Q
|
---|
| 78 | ;
|
---|
| 79 | ACLPT(TIUY,CLASS,DFN,TIME1,TIME2,OCCLIM,SEQUENCE) ; Signed, by patient
|
---|
| 80 | N DATTIM,DA,ROOT,TIUI,TIUJ
|
---|
| 81 | S ROOT=$NA(^TIU(8925,"ACLPT",CLASS,DFN)),TIUJ=0
|
---|
| 82 | S DATTIM=TIME1-.0000001
|
---|
| 83 | F S DATTIM=$O(@ROOT@(DATTIM)) Q:$S(+DATTIM'>0:1,+DATTIM>TIME2:1,+$G(TIUJ)'<OCCLIM:1,1:0) D
|
---|
| 84 | . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
|
---|
| 85 | . . ;Added first condition to following line for interdisciplinary notes - need addenda
|
---|
| 86 | . . I +$G(SHOWADD)=0,(+$G(^TIU(8925,+DA,0))=81) Q
|
---|
| 87 | . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
|
---|
| 88 | . . Q:+$D(@TIUY@("INDX",DA))
|
---|
| 89 | . . ; Selectively filter DELETED or RETRACTED records
|
---|
| 90 | . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
|
---|
| 91 | . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
|
---|
| 92 | . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
|
---|
| 93 | . . S TIUJ=+$G(TIUJ)+1
|
---|
| 94 | . . S @TIUY@("INDX",DA,TIUI)=""
|
---|
| 95 | . . Q:+$G(SHOWADD)=0
|
---|
| 96 | . . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 97 | . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 98 | Q
|
---|
| 99 | ;
|
---|
| 100 | ACLAU(TIUY,CLASS,AUTHOR,DFN,TIME1,TIME2,SEQUENCE,INCUND) ; Unsigned
|
---|
| 101 | N DATTIM,DA,ROOT,TIUI
|
---|
| 102 | S ROOT=$NA(^TIU(8925,"ACLAU",CLASS,AUTHOR,DFN))
|
---|
| 103 | S DATTIM=TIME1-.0000001
|
---|
| 104 | F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
|
---|
| 105 | . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
|
---|
| 106 | . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
|
---|
| 107 | . . I +$P($G(^TIU(8925,DA,0)),U,5)>6 K @ROOT@(DATTIM,DA) Q
|
---|
| 108 | . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
|
---|
| 109 | . . Q:+$D(@TIUY@("INDX",DA))
|
---|
| 110 | . . ; Selectively filter DELETED or RETRACTED records
|
---|
| 111 | . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
|
---|
| 112 | . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
|
---|
| 113 | . . S @TIUY@("INDX",DA,TIUI)=""
|
---|
| 114 | . . Q:+$G(SHOWADD)=0
|
---|
| 115 | . . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 116 | . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 117 | I +$G(INCUND) D GETUND^TIUSRVLI(.TIUY,CLASS,DFN,TIME1,TIME2,.TIUI,SEQUENCE)
|
---|
| 118 | Q
|
---|
| 119 | ;
|
---|
| 120 | ACLEC(TIUY,CLASS,EXCOSIGN,DFN,TIME1,TIME2,SEQUENCE) ; Uncosigned
|
---|
| 121 | N DATTIM,DA,ROOT,TIUI
|
---|
| 122 | S ROOT=$NA(^TIU(8925,"ACLEC",CLASS,EXCOSIGN,DFN))
|
---|
| 123 | S DATTIM=TIME1-.0000001
|
---|
| 124 | F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
|
---|
| 125 | . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
|
---|
| 126 | . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
|
---|
| 127 | . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
|
---|
| 128 | . . Q:+$D(@TIUY@("INDX",DA))
|
---|
| 129 | . . ; Selectively filter DELETED or RETRACTED records
|
---|
| 130 | . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
|
---|
| 131 | . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
|
---|
| 132 | . . S @TIUY@("INDX",DA,TIUI)=""
|
---|
| 133 | . . Q:+$G(SHOWADD)=0
|
---|
| 134 | . . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 135 | . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 136 | Q
|
---|
| 137 | ;
|
---|
| 138 | ACLSB(TIUY,CLASS,SIGNEDBY,DFN,TIME1,TIME2,SEQUENCE) ; Signed, by author
|
---|
| 139 | N DATTIM,DA,ROOT,TIUI
|
---|
| 140 | S ROOT=$NA(^TIU(8925,"ACLSB",CLASS,SIGNEDBY,DFN))
|
---|
| 141 | S DATTIM=TIME1-.0000001
|
---|
| 142 | F S DATTIM=$O(@ROOT@(DATTIM)) Q:DATTIM'>0!(DATTIM>TIME2) D
|
---|
| 143 | . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
|
---|
| 144 | . . I +$G(^TIU(8925,+DA,0))'>0 K @ROOT@(DATTIM,DA) Q
|
---|
| 145 | . . S TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
|
---|
| 146 | . . Q:+$D(@TIUY@("INDX",DA))
|
---|
| 147 | . . ; Selectively filter DELETED or RETRACTED records
|
---|
| 148 | . . I +$P($G(^TIU(8925,DA,0)),U,5)>13,'+$$CANDO^TIULP(DA,"VIEW",DUZ) Q
|
---|
| 149 | . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
|
---|
| 150 | . . S @TIUY@("INDX",DA,TIUI)=""
|
---|
| 151 | . . Q:+$G(SHOWADD)=0
|
---|
| 152 | . . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 153 | . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
|
---|
| 154 | Q
|
---|
| 155 | ;
|
---|
| 156 | RESOLVE(DA) ; Resolve to external data
|
---|
| 157 | N DOC,LOC,PT,AUT,EDT,TIUPT,TIULST4,TIUREC,TIUR0,TIUR12,TIUR13,TIUR14
|
---|
| 158 | N TIUR17,STATUS,EDTCNT,LOCTYP,TIUADT,TIUDDT,PREFIX,IDPARENT,IDSORT
|
---|
| 159 | S PREFIX=""
|
---|
| 160 | S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
|
---|
| 161 | S TIUR13=$G(^TIU(8925,+DA,13)),TIUR14=$G(^(14)),TIUR17=$G(^(17))
|
---|
| 162 | S IDPARENT=+$G(^TIU(8925,+DA,21))
|
---|
| 163 | S TIUPT=$G(^DPT(+$P(TIUR0,U,2),0))
|
---|
| 164 | S DOC=$$PNAME^TIULC1(+TIUR0)
|
---|
| 165 | I +$G(^TIU(8925.1,+DA,15)) D
|
---|
| 166 | . N TIUD15 S TIUD15=$G(^TIU(8925.1,+DA,15))
|
---|
| 167 | . S DOC=DOC_";"_$P($G(^TIU(8926.1,+TIUD15,0)),U)
|
---|
| 168 | I DOC="Addendum" S DOC=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
|
---|
| 169 | ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
|
---|
| 170 | ; which prefix to use:
|
---|
| 171 | ; - keep prefix display in earlier CPRS versions and LM
|
---|
| 172 | ; - omit in newer TreeView versions
|
---|
| 173 | I $L($T(PREFIX^TIULA2)) D I 1
|
---|
| 174 | . S PREFIX=$$PREFIX^TIULA2(DA,1) ; 1=include ID Child indicator
|
---|
| 175 | . I PREFIX["<" S IDSORT=$$IDSORT(DA)
|
---|
| 176 | . I +$G(SHOWADD)=0 S DOC=PREFIX_DOC
|
---|
| 177 | ; otherwise, only show addendum indicator (+)
|
---|
| 178 | ; - keep prefix display in earlier CPRS versions and LM
|
---|
| 179 | ; - omit in newer TreeView versions
|
---|
| 180 | E D
|
---|
| 181 | . I +$$HASADDEN^TIULC1(DA) S PREFIX="+ "
|
---|
| 182 | . I +$G(SHOWADD)=0,(+$$HASADDEN^TIULC1(DA)) S DOC=PREFIX_DOC
|
---|
| 183 | I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC
|
---|
| 184 | S STATUS=$$LOWER^TIULS($P($G(^TIU(8925.6,+$P(TIUR0,U,5),0)),U))
|
---|
| 185 | S LOC=$G(^SC(+$P(TIUR12,U,5),0)),LOCTYP=$P(LOC,U,3),LOC=$P(LOC,U)
|
---|
| 186 | S TIUADT=$S(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($P(TIUR0,U,7),"MM/DD/YY")
|
---|
| 187 | S TIUDDT=$S(+$P(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($P(TIUR0,U,8),"MM/DD/YY")
|
---|
| 188 | I +$G(SHOWADD)>0 S TIUADT=TIUADT_";"_$P(TIUR0,U,7),TIUDDT=TIUDDT_";"_$P(TIUR0,U,8)
|
---|
| 189 | S PT=$$NAME^TIULS($P(TIUPT,U),"LAST, FIRST MI")
|
---|
| 190 | S TIULST4=$E($P(TIUPT,U,9),6,9)
|
---|
| 191 | S TIULST4="("_$E(PT)_TIULST4_")"
|
---|
| 192 | S AUT=+$P(TIUR12,U,2)
|
---|
| 193 | S AUT=AUT_";"_$$SIGNAME^TIULS(+$P(TIUR12,U,2))_";"_$$GET1^DIQ(200,AUT,.01)
|
---|
| 194 | S EDT=+TIUR13,EDTCNT=+$G(EDTCNT)+1
|
---|
| 195 | 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
|
---|
| 196 | S TIUREC=TIUREC_$S($L(TIUR17):$E(TIUR17,1,(255-$L(TIUREC)))_U,1:U)
|
---|
| 197 | S TIUREC=TIUREC_$P(PREFIX," ")_U
|
---|
| 198 | S TIUREC=TIUREC_$S(+TIUR0=81:+$P(TIUR0,U,6),+IDPARENT:IDPARENT,+$G(CONTEXT):CONTEXT,1:1)_U_$G(IDSORT)
|
---|
| 199 | Q $G(TIUREC)
|
---|
| 200 | IMGCNT(TIUDA) ; Get the number of images associated with a document
|
---|
| 201 | N IMGDA,TIUI S (IMGDA,TIUI)=0
|
---|
| 202 | F S IMGDA=$O(^TIU(8925.91,"ADI",TIUDA,IMGDA)) Q:+IMGDA'>0 D
|
---|
| 203 | . S TIUI=TIUI+1
|
---|
| 204 | Q TIUI
|
---|
| 205 | IDSORT(TIUDA) ; Get ID Sort indicator when appropriate
|
---|
| 206 | N TIUDPRM
|
---|
| 207 | D DOCPRM^TIULC1(+$G(^TIU(8925,+TIUDA,0)),.TIUDPRM)
|
---|
| 208 | Q +$P(TIUDPRM(0),U,18)
|
---|