- TIUSRVLO ; SLC/JER - Server fns - lists for CPRS ;31-Dec-2012 15:27;DU
- ;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,1007,194,1010,211,1011**;Jun 20, 1997;Build 13
- ;IHS/MSC/MGH call to AWCMCPR1 commented out
- 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) ; 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
- S TIUY=$NA(^TMP("TIUR",$J))
- K @TIUY
- I $G(CONTEXT)'>0 Q
- I $G(CLASS)'>0 Q
- ;IHS/MSC/MGH Patch 1007 Commented out since IHS does not use this package
- ;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 $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)
- ;
- 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
- . . ;VMP OIFO BAY PINES;ELR;TIU*1.0*194 REMOVED EXECUTION OF ACLSB & ADDED APTCL
- . . ;D ACLSB(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
- . . 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) ; Signed, by patient
- N DATTIM,DA,ROOT,TIUI,TIUJ
- 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
- . S DA=0 F S DA=$O(@ROOT@(DATTIM,DA)) Q:DA'>0 D
- . . ;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
- . . 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 TIUI=$S(SEQUENCE="D":+$G(TIUI)+1,1:+$G(TIUI)-1)
- . . S @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
- . . S TIUJ=+$G(TIUJ)+1
- . . S @TIUY@("INDX",DA,TIUI)=""
- . . Q:+$G(SHOWADD)=0
- . . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- 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
- . . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- 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
- . . I +$$HASDAD^TIUSRVLI(DA) D SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- 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 SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- . . I +$$HASKIDS^TIUSRVLI(DA) D SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- 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=$$PNAME^TIULC1(+TIUR0)
- I +$G(^TIU(8925.1,+DA,15)) D
- . N TIUD15 S TIUD15=$G(^TIU(8925.1,+DA,15))
- . S DOC=DOC_";"_$P($G(^TIU(8926.1,+TIUD15,0)),U)
- 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)
- TIUSRVLO ; SLC/JER - Server fns - lists for CPRS ;31-Dec-2012 15:27;DU
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**1,15,19,63,108,122,181,1007,194,1010,211,1011**;Jun 20, 1997;Build 13
- +2 ;IHS/MSC/MGH call to AWCMCPR1 commented out
- 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) ; 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 SET TIUY=$NAME(^TMP("TIUR",$JOB))
- +17 KILL @TIUY
- +18 IF $GET(CONTEXT)'>0
- QUIT
- +19 IF $GET(CLASS)'>0
- QUIT
- +20 ;IHS/MSC/MGH Patch 1007 Commented out since IHS does not use this package
- +21 ;I $G(CONTEXT)=1 D STRT1^AWCMCPR1 ; TIU*1.0*181
- +22 IF +$GET(EARLY)'>0!(+$GET(CONTEXT)=1)
- SET EARLY=0
- +23 IF +$GET(LATE)'>0!(+$GET(CONTEXT)=1)
- SET LATE=5000000
- +24 IF EARLY>LATE
- DO SWAP(.EARLY,.LATE)
- +25 IF $LENGTH(LATE,".")=1
- DO EXPRANGE(.EARLY,.LATE)
- +26 IF +$GET(PERSON)'>0
- SET PERSON=DUZ
- +27 IF $GET(SEQUENCE)']""
- SET SEQUENCE="D"
- +28 IF +$GET(OCCLIM)'>0
- SET OCCLIM=9999999
- +29 SET DFN=+$GET(DFN)
- +30 ; CHANGE TO REVERSE DATES
- SET EARLY=9999999-EARLY
- SET LATE=9999999-LATE
- +31 ;
- +32 IF CONTEXT=1!(CONTEXT=5)
- Begin DoDot:1
- +33 DO ACLPT(.TIUY,CLASS,DFN,LATE,EARLY,OCCLIM,SEQUENCE)
- End DoDot:1
- GOTO CTXQ
- +34 ;
- +35 IF CONTEXT=2
- Begin DoDot:1
- +36 IF DFN>0
- Begin DoDot:2
- +37 DO ACLAU(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE,$GET(INCUND))
- End DoDot:2
- QUIT
- +38 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
- +39 ;
- +40 IF CONTEXT=3
- Begin DoDot:1
- +41 IF DFN>0
- Begin DoDot:2
- +42 DO ACLEC(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
- End DoDot:2
- QUIT
- +43 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
- +44 ;
- +45 IF CONTEXT=4
- Begin DoDot:1
- +46 IF DFN>0
- Begin DoDot:2
- +47 ;VMP OIFO BAY PINES;ELR;TIU*1.0*194 REMOVED EXECUTION OF ACLSB & ADDED APTCL
- +48 ;D ACLSB(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
- +49 DO APTCL^TIUSRVLP(.TIUY,CLASS,PERSON,DFN,LATE,EARLY,SEQUENCE)
- End DoDot:2
- QUIT
- +50 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
- +51 ;
- CTXQ KILL @TIUY@("INDX")
- +1 ; TIU*1.0*181
- IF $DATA(AWCSTRT)
- DO END^AWCMCPR1
- +2 QUIT
- +3 ;
- 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) ; Signed, by patient
- +1 NEW DATTIM,DA,ROOT,TIUI,TIUJ
- +2 SET ROOT=$NAME(^TIU(8925,"ACLPT",CLASS,DFN))
- SET TIUJ=0
- +3 SET DATTIM=TIME1-.0000001
- +4 FOR
- SET DATTIM=$ORDER(@ROOT@(DATTIM))
- IF $SELECT(+DATTIM'>0
- QUIT
- Begin DoDot:1
- +5 SET DA=0
- FOR
- SET DA=$ORDER(@ROOT@(DATTIM,DA))
- IF DA'>0
- QUIT
- Begin DoDot:2
- +6 ;Added first condition to following line for interdisciplinary notes - need addenda
- +7 IF +$GET(SHOWADD)=0
- IF (+$GET(^TIU(8925,+DA,0))=81)
- QUIT
- +8 IF +$GET(^TIU(8925,+DA,0))'>0
- KILL @ROOT@(DATTIM,DA)
- QUIT
- +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 TIUI=$SELECT(SEQUENCE="D":+$GET(TIUI)+1,1:+$GET(TIUI)-1)
- +13 SET @TIUY@(TIUI)=DA_U_$$RESOLVE(DA)
- +14 SET TIUJ=+$GET(TIUJ)+1
- +15 SET @TIUY@("INDX",DA,TIUI)=""
- +16 IF +$GET(SHOWADD)=0
- QUIT
- +17 IF +$$HASDAD^TIUSRVLI(DA)
- DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- +18 IF +$$HASKIDS^TIUSRVLI(DA)
- DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- End DoDot:2
- End DoDot:1
- +19 QUIT
- +20 ;
- 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 IF +$$HASDAD^TIUSRVLI(DA)
- DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- +16 IF +$$HASKIDS^TIUSRVLI(DA)
- DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- End DoDot:2
- End DoDot:1
- +17 IF +$GET(INCUND)
- DO GETUND^TIUSRVLI(.TIUY,CLASS,DFN,TIME1,TIME2,.TIUI,SEQUENCE)
- +18 QUIT
- +19 ;
- 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 IF +$$HASDAD^TIUSRVLI(DA)
- DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- +15 IF +$$HASKIDS^TIUSRVLI(DA)
- DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- 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)
- DO SETDAD^TIUSRVLI(.TIUY,DA,.TIUI)
- +15 IF +$$HASKIDS^TIUSRVLI(DA)
- DO SETKIDS^TIUSRVLI(.TIUY,DA,.TIUI)
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- 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=$$PNAME^TIULC1(+TIUR0)
- +9 IF +$GET(^TIU(8925.1,+DA,15))
- Begin DoDot:1
- +10 NEW TIUD15
- SET TIUD15=$GET(^TIU(8925.1,+DA,15))
- +11 SET DOC=DOC_";"_$PIECE($GET(^TIU(8926.1,+TIUD15,0)),U)
- End DoDot:1
- +12 IF DOC="Addendum"
- SET DOC=DOC_" to "_$$PNAME^TIULC1(+$GET(^TIU(8925,+$PIECE(TIUR0,U,6),0)))
- +13 ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
- +14 ; which prefix to use:
- +15 ; - keep prefix display in earlier CPRS versions and LM
- +16 ; - omit in newer TreeView versions
- +17 IF $LENGTH($TEXT(PREFIX^TIULA2))
- Begin DoDot:1
- +18 ; 1=include ID Child indicator
- SET PREFIX=$$PREFIX^TIULA2(DA,1)
- +19 IF PREFIX["<"
- SET IDSORT=$$IDSORT(DA)
- +20 IF +$GET(SHOWADD)=0
- SET DOC=PREFIX_DOC
- End DoDot:1
- IF 1
- +21 ; otherwise, only show addendum indicator (+)
- +22 ; - keep prefix display in earlier CPRS versions and LM
- +23 ; - omit in newer TreeView versions
- +24 IF '$TEST
- Begin DoDot:1
- +25 IF +$$HASADDEN^TIULC1(DA)
- SET PREFIX="+ "
- +26 IF +$GET(SHOWADD)=0
- IF (+$$HASADDEN^TIULC1(DA))
- SET DOC=PREFIX_DOC
- End DoDot:1
- +27 IF +$$URGENCY^TIURM(+DA)=1
- SET DOC=$SELECT(DOC["+":"*",1:"* ")_DOC
- +28 SET STATUS=$$LOWER^TIULS($PIECE($GET(^TIU(8925.6,+$PIECE(TIUR0,U,5),0)),U))
- +29 SET LOC=$GET(^SC(+$PIECE(TIUR12,U,5),0))
- SET LOCTYP=$PIECE(LOC,U,3)
- SET LOC=$PIECE(LOC,U)
- +30 SET TIUADT=$SELECT(LOCTYP="W":"Adm: ",1:"Visit: ")_$$DATE^TIULS($PIECE(TIUR0,U,7),"MM/DD/YY")
- +31 SET TIUDDT=$SELECT(+$PIECE(TIUR0,U,8):"Dis: ",1:"")_$$DATE^TIULS($PIECE(TIUR0,U,8),"MM/DD/YY")
- +32 IF +$GET(SHOWADD)>0
- SET TIUADT=TIUADT_";"_$PIECE(TIUR0,U,7)
- SET TIUDDT=TIUDDT_";"_$PIECE(TIUR0,U,8)
- +33 SET PT=$$NAME^TIULS($PIECE(TIUPT,U),"LAST, FIRST MI")
- +34 SET TIULST4=$EXTRACT($PIECE(TIUPT,U,9),6,9)
- +35 SET TIULST4="("_$EXTRACT(PT)_TIULST4_")"
- +36 SET AUT=+$PIECE(TIUR12,U,2)
- +37 SET AUT=AUT_";"_$$SIGNAME^TIULS(+$PIECE(TIUR12,U,2))_";"_$$GET1^DIQ(200,AUT,.01)
- +38 SET EDT=+TIUR13
- SET EDTCNT=+$GET(EDTCNT)+1
- +39 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
- +40 SET TIUREC=TIUREC_$SELECT($LENGTH(TIUR17):$EXTRACT(TIUR17,1,(255-$LENGTH(TIUREC)))_U,1:U)
- +41 SET TIUREC=TIUREC_$PIECE(PREFIX," ")_U
- +42 SET TIUREC=TIUREC_$SELECT(+TIUR0=81:+$PIECE(TIUR0,U,6),+IDPARENT:IDPARENT,+$GET(CONTEXT):CONTEXT,1:1)_U_$GET(IDSORT)
- +43 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)