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

TIUSRVR2.m

Go to the documentation of this file. 
  1. TIUSRVR2 ; SLC/JER - RPC for record-wise GET ; 11/23/07
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,162,211,222,234,286**;Jun 20, 1997;Build 10
  1.  ;;Per VA Directive 6402, this routine should not be modified
  1.  ; 4/12/01 Moved signature modules to new rtn TIUSRVR3
  1. LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL,ACTION) ; Load ^TMP
  1.  ;Requires TIUDA, array TIUL, TIUGDATA
  1.  ;optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
  1.  ;                    loading the whole note after the original entry,
  1.  ;                    so DON'T load the whole note again.
  1.  N TIUKID,TIUDADT,TIUI,CANSEE
  1.  N TIUPARNT,TIUPNAME,TIUPDATE
  1.  N TIUGPRNT,TIUGPNM,TIUGPDT,TIUPDATA,TIUHASKD
  1.  S ACTION=$G(ACTION,"VIEW")
  1.  ; ---- If user cannot view, say so and quit: ----
  1.  ;      TIU*1*100
  1.  S CANSEE=$S(+$$ISCOMP^TIUSRVR1(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,ACTION))
  1.  I +CANSEE'>0 D  Q
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(CANSEE,U,2)
  1.  ; ---- Load text of TIUDA: ----
  1.  S TIUI=0
  1.  F  S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0  D
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0))
  1.  ; ---- if TIUDA is a COMPONENT, QUIT
  1.  Q:+$$ISCOMP^TIUSRVR1(TIUDA)
  1.  ; ---- If TIUDA **IS** an addendum, load addm signature,
  1.  ;         load original document, quit: ----
  1.  I +$$ISADDNDM^TIULC1(+TIUDA) D  Q
  1.  . N TIULINE,TIUPARNT S $P(TIULINE,"=",79)=""
  1.  . D LOADSIG^TIUSRVR3(TIUDA,.TIUL)
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1.  . S TIUPARNT=+$P(^TIU(8925,+TIUDA,0),U,6)
  1.  . S TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
  1.  . S TIUPDATE=+$G(^TIU(8925,TIUPARNT,13))
  1.  . S TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
  1.  . S TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
  1.  . S TIUHASKD=$P(TIUPDATA,U,2),TIUGPRNT=+$P(TIUPDATA,U,3)
  1.  . S TIUL=+$G(TIUL)+1
  1.  . I TIUHASKD D
  1.  . . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
  1.  . I TIUGPRNT D
  1.  . . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
  1.  . . S TIUGPNM=$$PNAME^TIULC1(+^TIU(8925,TIUGPRNT,0))
  1.  . . S TIUGPDT=+$G(^TIU(8925,TIUGPRNT,13))
  1.  . . S TIUGPDT=$$DATE^TIULS(TIUGPDT,"MM/DD/YY")
  1.  . I 'TIUHASKD,'TIUGPRNT S @TIUARR@(TIUL)=" --- Original Document ---"
  1.  . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=""
  1.  . S TIUL=+$G(TIUL)+1
  1.  . I TIUHASKD D
  1.  . . S @TIUARR@(TIUL)="                    << Addended Interdisciplinary Entry >>"
  1.  . . S TIUL=+$G(TIUL)+1
  1.  . . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
  1.  . I TIUGPRNT D
  1.  . . S @TIUARR@(TIUL)="                         << Interdisciplinary Note >>"
  1.  . . S TIUL=+$G(TIUL)+1
  1.  . . S @TIUARR@(TIUL)=TIUGPDT_" "_TIUGPNM
  1.  . . S TIUL=+$G(TIUL)+1
  1.  . . S @TIUARR@(TIUL)="                    << Addended Interdisciplinary Entry >>"
  1.  . . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
  1.  . I 'TIUHASKD,'TIUGPRNT D
  1.  . . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
  1.  . D LOADREC(TIUPARNT,.TIUL,TIUGDATA)
  1.  ; ---- Load components of TIUDA: ----
  1.  S TIUKID=0
  1.  F  S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0  D
  1.  . I +$$ISADDNDM^TIULC1(TIUKID)'>0 D LOADREC(TIUKID,.TIUL,$G(TIUGDATA))
  1.  ; ---- Load signature of TIUDA if TIUDA is not addm
  1.  ;           or comp: ----
  1.  ; *222 don't display sig info. for FORM LETTERS
  1.  I '+$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D
  1.  . I '$$ISCOMP^TIUSRVR1(TIUDA) D LOADSIG^TIUSRVR3(TIUDA,.TIUL)
  1.  ; ---- Load addenda of TIUDA: ----
  1.  S TIUKID=0
  1.  F  S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0  D
  1.  . ; If acting on an addendum, don't show it again.
  1.  . I +TIUKID=+$G(^TMP("TIU FOCUS",$J)) Q
  1.  . I +$$ISADDNDM^TIULC1(TIUKID) D LOADADD(TIUKID,.TIUL)
  1.  N IDDAD
  1.  S IDDAD=+$P(TIUGDATA,U,3)
  1.  ; ---- If Browsed Record is an ID Note, & this cycle has
  1.  ;      just loaded the parent entry, then load ID kids
  1.  ;      and quit: **100** ----
  1.  I $P(TIUGDATA,U,2),TIUDA=+TIUGDATA D LOADKIDS(TIUDA,.TIUL,TIUGDATA) Q
  1.  ; ---- If Browsed Record is an ID Entry, & this cycle hasn't begun
  1.  ;      loading the whole note, then load the whole ID Note after
  1.  ;      the browsed entry and quit: ----
  1.  I IDDAD,'$G(TIUGWHOL) D  Q
  1.  . S TIUGWHOL=1
  1.  . N TIULINE S $P(TIULINE,"=",79)=""
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=" --- Interdisciplinary Note ---"
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1.  . D LOADID(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
  1.  ; ---- If Browsed Record is an ID Entry, & this cycle has begun
  1.  ;      loading the whole ID note, and is currently loading the first
  1.  ;      entry of the whole note, then load kids and quit: ----
  1.  I IDDAD,$G(TIUGWHOL),TIUDA=IDDAD D LOADKIDS(TIUDA,.TIUL,TIUGDATA,TIUGWHOL) K TIUGWHOL
  1.  Q
  1.  ;
  1. LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
  1.  ; Requires TIUDA, array TIUL, TIUGDATA
  1.  N TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
  1.  I $G(^TMP("TIUR",$J,"IDDATA",TIUDA)) S PRMSORT=$P(^TMP("TIUR",$J,"IDDATA",TIUDA),U,4)
  1.  E  S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD21=$G(^TIU(8925,TIUDA,21)),PRMSORT=$P($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
  1.  D GETIDKID^TIURECL2(TIUDA,PRMSORT) ; sets array ^TMP("TIUIDKID",$J,
  1.  S TIUK=0
  1.  F  S TIUK=$O(^TMP("TIUIDKID",$J,TIUDA,TIUK)) Q:+TIUK'>0  D
  1.  . S KIDDA=^TMP("TIUIDKID",$J,TIUDA,TIUK)
  1.  . D LOADID(KIDDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
  1.  K ^TMP("TIUIDKID",$J)
  1.  Q
  1.  ;
  1. LOADID(TIUDA,TIUL,TIUGDATA,TIUWHOL) ; Load ID note for browse
  1.  N TIUREC,TIU
  1.  I '$D(^TIU(8925,+TIUDA,0)) Q
  1.  ; ---- If ID Kid has focus, don't show it again ----
  1.  ; I TIUDA=+$G(^TMP("TIU FOCUS",$J)) Q
  1.  S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1.  D GETTIU^TIULD(.TIU,+TIUDA)
  1.  D INQUIRE(TIUDA,.TIUREC)
  1.  ; ---- Load info missing from header since this is ID note entry: ----
  1.  ; ---- Load dictation, transcription data, etc.: ----
  1.  D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,$G(TIUGDATA))
  1.  ; ---- Load the remainder of the record: ----
  1.  D LOADREC(TIUDA,.TIUL,$G(TIUGDATA),$G(TIUWHOL))
  1.  Q
  1.  ;
  1. INQUIRE(TIUDA,TIUREC,TIUCPF) ; Inquire to document TIUDA and set TIUREC
  1.  N DA,DIC,DIQ,DR
  1.  S DA=TIUDA,DIC=8925,DIQ="TIUREC("
  1.  S DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506;89261"
  1.  ;If the document is a member of the Clinical Procedures Class, include the
  1.  ;Procedure Summary Code field and the Date/Time Performed field
  1.  I $G(TIUCPF) S DR=DR_";70201;70202"
  1.  D EN^DIQ1
  1.  Q
  1. LOADADD(TIUDADD,TIUL) ; Load addenda
  1.  N TIUDAUTH,TIUDATT,TIUJ,TIUSIG,TIUCSIG,TIUVIEW
  1.  S TIUL=TIUL+1,@TIUARR@(TIUL)=""
  1.  S TIUDADT=$$DATE^TIULS($P($G(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
  1.  S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUDADT_" ADDENDUM"_"                      STATUS: "_$$STATUS^TIULF(TIUDADD) ;P162
  1.  S TIUVIEW=$$CANDO^TIULP(+TIUDADD,"VIEW")
  1.  I '+TIUVIEW D  Q
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(TIUVIEW,U,2)
  1.  S TIUJ=0
  1.  F  S TIUJ=$O(^TIU(8925,+TIUDADD,"TEXT",TIUJ)) Q:+TIUJ'>0  D
  1.  . S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0))
  1.  D LOADSIG^TIUSRVR3(TIUDADD,.TIUL)
  1.  Q