TIUVPR ;SLC/JER,MKB,ASMR/BL - Server fns - lists for VPR ; 10/16/15 2:12pm
;;1.0;TEXT INTEGRATION UTILITIES;**106**;Jun 20, 1997;Build 328
;Per VA Directive 6402, this routine should not be modified.
;
NOTES(TIUY,DFN,EARLY,LATE) ; Gets list of Notes
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
D LIST(TIUY,DFN,3,$G(EARLY),$G(LATE))
Q
SUMMARY(TIUY,DFN,EARLY,LATE) ; Gets list of Summaries
I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
D LIST(TIUY,DFN,244,$G(EARLY),$G(LATE))
Q
;
LIST(TIUY,DFN,CLASS,EARLY,LATE,STATUS) ; Build List of [parent] documents
; TIUY - Return array name, pass by reference
; DFN - Pointer to PATIENT #2
; [CLASS] - PN,CR,C,W,A,D,DS,SR,CP,LR [default=ALL]
; or TIU DOCUMENT DEFINITION #8925.1 ien
; [EARLY] - FM date/time to begin search
; [LATE] - FM date/time to end search
; [STATUS] - Name of TIU STATUS #8925.6 [default=COMPLETED]
;
; Returns @TIUY@(DA) = ""
; @TIUY@("COUNT") = total# documents
;
N TIUCOUNT,TIUC,SUB,TIUI,TIUDA,TIU0,TIUTYPE,DAD,DA
S TIUCOUNT=0,TIUY=$NA(^TMP("TIULIST",$J)) K @TIUY
S CLASS=$G(CLASS,"ALL"),STATUS=$G(STATUS,"COMPLETED"),SUB=0
; accept Class ien, or convert code to ien
I +CLASS=CLASS S TIUC=+CLASS
E S TIUC=$S(CLASS="ALL":38,CLASS="DS":244,CLASS="SR":$$CLASS("SURGICAL REPORTS"),CLASS="LR":$$CLASS("LR LABORATORY REPORTS"),CLASS="CP":$$CLASS("CLINICAL PROCEDURES"),CLASS="RA":0,1:3)
I "CRWAD"[CLASS S SUB=$S(CLASS="C":30,CLASS="W":31,CLASS="A":25,CLASS="D":27,1:$$CLASS("CONSULTS"))
S EARLY=9999999-+$G(EARLY),TIUI=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)-.000001
F S TIUI=$O(^TIU(8925,"APTCL",DFN,TIUC,TIUI)) Q:TIUI<1!(TIUI>EARLY) D
. S TIUDA=0 F S TIUDA=$O(^TIU(8925,"APTCL",DFN,TIUC,TIUI,TIUDA)) Q:+TIUDA'>0 D
.. Q:$D(@TIUY@(TIUDA))
.. S TIU0=$G(^TIU(8925,TIUDA,0)),TIUTYPE=$G(^TIU(8925.1,+TIU0,0))
.. I $P(TIUTYPE,U,4)="CO" Q
.. I SUB,$P(TIU0,U,4)'=SUB Q
.. S DAD=$S($P(TIUTYPE,U)["ADDENDUM":+$P(TIU0,U,6),1:0),DA=TIUDA
.. I STATUS="COMPLETED",$P(TIU0,U,5)<7!($P(TIU0,U,5)>13)!DAD Q
.. I STATUS="UNSIGNED" Q:'$$UNSIG(TIUDA,DUZ)
.. I DAD Q:$D(@TIUY@(DAD)) S DA=DAD
.. ; add to array
.. S TIUCOUNT=TIUCOUNT+1,@TIUY@(DA)=""
S @TIUY@("COUNT")=$G(TIUCOUNT)
Q
;
CLASS(CLNAME) ; -- Returns the TIU [Document] Class for CLNAME
N TIUY S TIUY=+$O(^TIU(8925.1,"B",CLNAME,0))
I +TIUY>0,$S($P($G(^TIU(8925.1,+TIUY,0)),U,4)="CL":0,$P($G(^(0)),U,4)="DC":0,1:1) S TIUY=0
Q TIUY
;
UNSIG(IEN,USER) ; -- Return 1 or 0, if note IEN is unsigned for USER
I $P(TIU0,U,5)>5 Q 0
I $P($G(^TIU(8925,IEN,12)),U,2)=DUZ Q 1
I $P($G(^TIU(8925,IEN,13)),U,2)=DUZ Q 1
Q 0
;
GET(TIUY,DFN,CLASS,EARLY,LATE) ; Build List of [parent only] documents
; TIUY - Return array, pass name by reference
; DFN - Pointer to PATIENT #2
; CLASS - Pointer to TIU DOCUMENT DEFINITION #8925.1
; [EARLY] - FM date/time to begin search
; [LATE] - FM date/time to end search
;
; Returns @TIUY@(#) = DA
; @TIUY@("COUNT") = total# documents
;
N TIUCOUNT,TIUI,DA
S TIUCOUNT=0,TIUY=$NA(^TMP("TIULIST",$J)) K @TIUY
I +$G(CLASS)'>0 S CLASS=38 ;S @TIUY@("COUNT")=0 Q
S EARLY=9999999-+$G(EARLY),TIUI=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
F S TIUI=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI)) Q:TIUI<1!(TIUI>EARLY) D
. S DA=0 F S DA=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI,DA)) Q:+DA'>0 D
. . I +$$ISADDNDM^TIULC1(+DA) Q ;no addenda
. . I +$$ISCOMP^TIUSRVR1(+DA) Q ;no components
. . ;I +$G(^TIU(8925,+DA,21)) Q ;no id children
. . S TIUCOUNT=TIUCOUNT+1
. . S @TIUY@(TIUCOUNT)=DA
S @TIUY@("COUNT")=$G(TIUCOUNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUVPR 3660 printed Apr 09, 2024@21:45:11 Page 2
TIUVPR ;SLC/JER,MKB,ASMR/BL - Server fns - lists for VPR ; 10/16/15 2:12pm
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**106**;Jun 20, 1997;Build 328
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
NOTES(TIUY,DFN,EARLY,LATE) ; Gets list of Notes
+1 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+2 DO LIST(TIUY,DFN,3,$GET(EARLY),$GET(LATE))
+3 QUIT
SUMMARY(TIUY,DFN,EARLY,LATE) ; Gets list of Summaries
+1 IF $SELECT(+$GET(DFN)'>0:1,'$DATA(^DPT(+$GET(DFN),0)):1,1:0)
QUIT
+2 DO LIST(TIUY,DFN,244,$GET(EARLY),$GET(LATE))
+3 QUIT
+4 ;
LIST(TIUY,DFN,CLASS,EARLY,LATE,STATUS) ; Build List of [parent] documents
+1 ; TIUY - Return array name, pass by reference
+2 ; DFN - Pointer to PATIENT #2
+3 ; [CLASS] - PN,CR,C,W,A,D,DS,SR,CP,LR [default=ALL]
+4 ; or TIU DOCUMENT DEFINITION #8925.1 ien
+5 ; [EARLY] - FM date/time to begin search
+6 ; [LATE] - FM date/time to end search
+7 ; [STATUS] - Name of TIU STATUS #8925.6 [default=COMPLETED]
+8 ;
+9 ; Returns @TIUY@(DA) = ""
+10 ; @TIUY@("COUNT") = total# documents
+11 ;
+12 NEW TIUCOUNT,TIUC,SUB,TIUI,TIUDA,TIU0,TIUTYPE,DAD,DA
+13 SET TIUCOUNT=0
SET TIUY=$NAME(^TMP("TIULIST",$JOB))
KILL @TIUY
+14 SET CLASS=$GET(CLASS,"ALL")
SET STATUS=$GET(STATUS,"COMPLETED")
SET SUB=0
+15 ; accept Class ien, or convert code to ien
+16 IF +CLASS=CLASS
SET TIUC=+CLASS
+17 IF '$TEST
SET TIUC=$SELECT(CLASS="ALL":38,CLASS="DS":244,CLASS="SR":$$CLASS("SURGICAL REPORTS"),CLASS="LR":$$CLASS("LR LABORATORY REPORTS"),CLASS="CP":$$CLASS("CLINICAL PROCEDURES"),CLASS="RA":0,1:3)
+18 IF "CRWAD"[CLASS
SET SUB=$SELECT(CLASS="C":30,CLASS="W":31,CLASS="A":25,CLASS="D":27,1:$$CLASS("CONSULTS"))
+19 SET EARLY=9999999-+$GET(EARLY)
SET TIUI=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)-.000001
+20 FOR
SET TIUI=$ORDER(^TIU(8925,"APTCL",DFN,TIUC,TIUI))
if TIUI<1!(TIUI>EARLY)
QUIT
Begin DoDot:1
+21 SET TIUDA=0
FOR
SET TIUDA=$ORDER(^TIU(8925,"APTCL",DFN,TIUC,TIUI,TIUDA))
if +TIUDA'>0
QUIT
Begin DoDot:2
+22 if $DATA(@TIUY@(TIUDA))
QUIT
+23 SET TIU0=$GET(^TIU(8925,TIUDA,0))
SET TIUTYPE=$GET(^TIU(8925.1,+TIU0,0))
+24 IF $PIECE(TIUTYPE,U,4)="CO"
QUIT
+25 IF SUB
IF $PIECE(TIU0,U,4)'=SUB
QUIT
+26 SET DAD=$SELECT($PIECE(TIUTYPE,U)["ADDENDUM":+$PIECE(TIU0,U,6),1:0)
SET DA=TIUDA
+27 IF STATUS="COMPLETED"
IF $PIECE(TIU0,U,5)<7!($PIECE(TIU0,U,5)>13)!DAD
QUIT
+28 IF STATUS="UNSIGNED"
if '$$UNSIG(TIUDA,DUZ)
QUIT
+29 IF DAD
if $DATA(@TIUY@(DAD))
QUIT
SET DA=DAD
+30 ; add to array
+31 SET TIUCOUNT=TIUCOUNT+1
SET @TIUY@(DA)=""
End DoDot:2
End DoDot:1
+32 SET @TIUY@("COUNT")=$GET(TIUCOUNT)
+33 QUIT
+34 ;
CLASS(CLNAME) ; -- Returns the TIU [Document] Class for CLNAME
+1 NEW TIUY
SET TIUY=+$ORDER(^TIU(8925.1,"B",CLNAME,0))
+2 IF +TIUY>0
IF $SELECT($PIECE($GET(^TIU(8925.1,+TIUY,0)),U,4)="CL":0,$PIECE($GET(^(0)),U,4)="DC":0,1:1)
SET TIUY=0
+3 QUIT TIUY
+4 ;
UNSIG(IEN,USER) ; -- Return 1 or 0, if note IEN is unsigned for USER
+1 IF $PIECE(TIU0,U,5)>5
QUIT 0
+2 IF $PIECE($GET(^TIU(8925,IEN,12)),U,2)=DUZ
QUIT 1
+3 IF $PIECE($GET(^TIU(8925,IEN,13)),U,2)=DUZ
QUIT 1
+4 QUIT 0
+5 ;
GET(TIUY,DFN,CLASS,EARLY,LATE) ; Build List of [parent only] documents
+1 ; TIUY - Return array, pass name by reference
+2 ; DFN - Pointer to PATIENT #2
+3 ; CLASS - Pointer to TIU DOCUMENT DEFINITION #8925.1
+4 ; [EARLY] - FM date/time to begin search
+5 ; [LATE] - FM date/time to end search
+6 ;
+7 ; Returns @TIUY@(#) = DA
+8 ; @TIUY@("COUNT") = total# documents
+9 ;
+10 NEW TIUCOUNT,TIUI,DA
+11 SET TIUCOUNT=0
SET TIUY=$NAME(^TMP("TIULIST",$JOB))
KILL @TIUY
+12 ;S @TIUY@("COUNT")=0 Q
IF +$GET(CLASS)'>0
SET CLASS=38
+13 SET EARLY=9999999-+$GET(EARLY)
SET TIUI=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)
+14 FOR
SET TIUI=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUI))
if TIUI<1!(TIUI>EARLY)
QUIT
Begin DoDot:1
+15 SET DA=0
FOR
SET DA=$ORDER(^TIU(8925,"APTCL",DFN,CLASS,TIUI,DA))
if +DA'>0
QUIT
Begin DoDot:2
+16 ;no addenda
IF +$$ISADDNDM^TIULC1(+DA)
QUIT
+17 ;no components
IF +$$ISCOMP^TIUSRVR1(+DA)
QUIT
+18 ;I +$G(^TIU(8925,+DA,21)) Q ;no id children
+19 SET TIUCOUNT=TIUCOUNT+1
+20 SET @TIUY@(TIUCOUNT)=DA
End DoDot:2
End DoDot:1
+21 SET @TIUY@("COUNT")=$GET(TIUCOUNT)
+22 QUIT
