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

TIUVPR.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. NOTES(TIUY,DFN,EARLY,LATE) ; Gets list of Notes
  1. I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
  1. D LIST(TIUY,DFN,3,$G(EARLY),$G(LATE))
  1. Q
  1. SUMMARY(TIUY,DFN,EARLY,LATE) ; Gets list of Summaries
  1. I $S(+$G(DFN)'>0:1,'$D(^DPT(+$G(DFN),0)):1,1:0) Q
  1. D LIST(TIUY,DFN,244,$G(EARLY),$G(LATE))
  1. Q
  1. ;
  1. LIST(TIUY,DFN,CLASS,EARLY,LATE,STATUS) ; Build List of [parent] documents
  1. ; TIUY - Return array name, pass by reference
  1. ; DFN - Pointer to PATIENT #2
  1. ; [CLASS] - PN,CR,C,W,A,D,DS,SR,CP,LR [default=ALL]
  1. ; or TIU DOCUMENT DEFINITION #8925.1 ien
  1. ; [EARLY] - FM date/time to begin search
  1. ; [LATE] - FM date/time to end search
  1. ; [STATUS] - Name of TIU STATUS #8925.6 [default=COMPLETED]
  1. ;
  1. ; Returns @TIUY@(DA) = ""
  1. ; @TIUY@("COUNT") = total# documents
  1. ;
  1. N TIUCOUNT,TIUC,SUB,TIUI,TIUDA,TIU0,TIUTYPE,DAD,DA
  1. S TIUCOUNT=0,TIUY=$NA(^TMP("TIULIST",$J)) K @TIUY
  1. S CLASS=$G(CLASS,"ALL"),STATUS=$G(STATUS,"COMPLETED"),SUB=0
  1. ; accept Class ien, or convert code to ien
  1. I +CLASS=CLASS S TIUC=+CLASS
  1. 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)
  1. I "CRWAD"[CLASS S SUB=$S(CLASS="C":30,CLASS="W":31,CLASS="A":25,CLASS="D":27,1:$$CLASS("CONSULTS"))
  1. S EARLY=9999999-+$G(EARLY),TIUI=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)-.000001
  1. F S TIUI=$O(^TIU(8925,"APTCL",DFN,TIUC,TIUI)) Q:TIUI<1!(TIUI>EARLY) D
  1. . S TIUDA=0 F S TIUDA=$O(^TIU(8925,"APTCL",DFN,TIUC,TIUI,TIUDA)) Q:+TIUDA'>0 D
  1. .. Q:$D(@TIUY@(TIUDA))
  1. .. S TIU0=$G(^TIU(8925,TIUDA,0)),TIUTYPE=$G(^TIU(8925.1,+TIU0,0))
  1. .. I $P(TIUTYPE,U,4)="CO" Q
  1. .. I SUB,$P(TIU0,U,4)'=SUB Q
  1. .. S DAD=$S($P(TIUTYPE,U)["ADDENDUM":+$P(TIU0,U,6),1:0),DA=TIUDA
  1. .. I STATUS="COMPLETED",$P(TIU0,U,5)<7!($P(TIU0,U,5)>13)!DAD Q
  1. .. I STATUS="UNSIGNED" Q:'$$UNSIG(TIUDA,DUZ)
  1. .. I DAD Q:$D(@TIUY@(DAD)) S DA=DAD
  1. .. ; add to array
  1. .. S TIUCOUNT=TIUCOUNT+1,@TIUY@(DA)=""
  1. S @TIUY@("COUNT")=$G(TIUCOUNT)
  1. Q
  1. ;
  1. CLASS(CLNAME) ; -- Returns the TIU [Document] Class for CLNAME
  1. N TIUY S TIUY=+$O(^TIU(8925.1,"B",CLNAME,0))
  1. 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
  1. Q TIUY
  1. ;
  1. UNSIG(IEN,USER) ; -- Return 1 or 0, if note IEN is unsigned for USER
  1. I $P(TIU0,U,5)>5 Q 0
  1. I $P($G(^TIU(8925,IEN,12)),U,2)=DUZ Q 1
  1. I $P($G(^TIU(8925,IEN,13)),U,2)=DUZ Q 1
  1. Q 0
  1. ;
  1. GET(TIUY,DFN,CLASS,EARLY,LATE) ; Build List of [parent only] documents
  1. ; TIUY - Return array, pass name by reference
  1. ; DFN - Pointer to PATIENT #2
  1. ; CLASS - Pointer to TIU DOCUMENT DEFINITION #8925.1
  1. ; [EARLY] - FM date/time to begin search
  1. ; [LATE] - FM date/time to end search
  1. ;
  1. ; Returns @TIUY@(#) = DA
  1. ; @TIUY@("COUNT") = total# documents
  1. ;
  1. N TIUCOUNT,TIUI,DA
  1. S TIUCOUNT=0,TIUY=$NA(^TMP("TIULIST",$J)) K @TIUY
  1. I +$G(CLASS)'>0 S CLASS=38 ;S @TIUY@("COUNT")=0 Q
  1. S EARLY=9999999-+$G(EARLY),TIUI=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
  1. F S TIUI=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI)) Q:TIUI<1!(TIUI>EARLY) D
  1. . S DA=0 F S DA=$O(^TIU(8925,"APTCL",DFN,CLASS,TIUI,DA)) Q:+DA'>0 D
  1. . . I +$$ISADDNDM^TIULC1(+DA) Q ;no addenda
  1. . . I +$$ISCOMP^TIUSRVR1(+DA) Q ;no components
  1. . . ;I +$G(^TIU(8925,+DA,21)) Q ;no id children
  1. . . S TIUCOUNT=TIUCOUNT+1
  1. . . S @TIUY@(TIUCOUNT)=DA
  1. S @TIUY@("COUNT")=$G(TIUCOUNT)
  1. Q