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