TIUSRVR2 ; SLC/JER - RPC for record-wise GET ; 11/23/07
;;1.0;TEXT INTEGRATION UTILITIES;**100,109,162,222,234**;Jun 20, 1997;Build 6
; 4/12/01 Moved signature modules to new rtn TIUSRVR3
LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL,ACTION) ; Load ^TMP
;Requires TIUDA, array TIUL, TIUGDATA
;optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
; loading the whole note after the original entry,
; so DON'T load the whole note again.
N TIUKID,TIUDADT,TIUI,CANSEE
N TIUPARNT,TIUPNAME,TIUPDATE
N TIUGPRNT,TIUGPNM,TIUGPDT,TIUPDATA,TIUHASKD
S ACTION=$G(ACTION,"VIEW")
; ---- If user cannot view, say so and quit: ----
; TIU*1*100
S CANSEE=$S(+$$ISCOMP^TIUSRVR1(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,ACTION))
I +CANSEE'>0 D Q
. S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(CANSEE,U,2)
; ---- Load text of TIUDA: ----
S TIUI=0
F S TIUI=$O(^TIU(8925,+TIUDA,"TEXT",TIUI)) Q:+TIUI'>0 D
. S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDA,"TEXT",+TIUI,0))
; ---- if TIUDA is a COMPONENT, QUIT
Q:+$$ISCOMP^TIUSRVR1(TIUDA)
; ---- If TIUDA **IS** an addendum, load addm signature,
; load original document, quit: ----
I +$$ISADDNDM^TIULC1(+TIUDA) D Q
. N TIULINE,TIUPARNT S $P(TIULINE,"=",79)=""
. D LOADSIG^TIUSRVR3(TIUDA,.TIUL)
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
. S TIUPARNT=+$P(^TIU(8925,+TIUDA,0),U,6)
. S TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
. S TIUPDATE=+$G(^TIU(8925,TIUPARNT,13))
. S TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
. S TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
. S TIUHASKD=$P(TIUPDATA,U,2),TIUGPRNT=+$P(TIUPDATA,U,3)
. S TIUL=+$G(TIUL)+1
. I TIUHASKD D
. . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
. I TIUGPRNT D
. . S @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
. . S TIUGPNM=$$PNAME^TIULC1(+^TIU(8925,TIUGPRNT,0))
. . S TIUGPDT=+$G(^TIU(8925,TIUGPRNT,13))
. . S TIUGPDT=$$DATE^TIULS(TIUGPDT,"MM/DD/YY")
. I 'TIUHASKD,'TIUGPRNT S @TIUARR@(TIUL)=" --- Original Document ---"
. S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=""
. S TIUL=+$G(TIUL)+1
. I TIUHASKD D
. . S @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>"
. . S TIUL=+$G(TIUL)+1
. . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
. I TIUGPRNT D
. . S @TIUARR@(TIUL)=" << Interdisciplinary Note >>"
. . S TIUL=+$G(TIUL)+1
. . S @TIUARR@(TIUL)=TIUGPDT_" "_TIUGPNM
. . S TIUL=+$G(TIUL)+1
. . S @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>"
. . S TIUL=+$G(TIUL)+1,@TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
. I 'TIUHASKD,'TIUGPRNT D
. . S @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
. D LOADREC(TIUPARNT,.TIUL,TIUGDATA)
; ---- Load components of TIUDA: ----
S TIUKID=0
F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
. I +$$ISADDNDM^TIULC1(TIUKID)'>0 D LOADREC(TIUKID,.TIUL,$G(TIUGDATA))
; ---- Load signature of TIUDA if TIUDA is not addm
; or comp: ----
; *222 don't display sig info. for FORM LETTERS
I '+$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+TIUDA,0)),"FORM LETTERS") D
. I '$$ISCOMP^TIUSRVR1(TIUDA) D LOADSIG^TIUSRVR3(TIUDA,.TIUL)
; ---- Load addenda of TIUDA: ----
S TIUKID=0
F S TIUKID=$O(^TIU(8925,"DAD",+TIUDA,TIUKID)) Q:+TIUKID'>0 D
. ; If acting on an addendum, don't show it again.
. I +TIUKID=+$G(^TMP("TIU FOCUS",$J)) Q
. I +$$ISADDNDM^TIULC1(TIUKID) D LOADADD(TIUKID,.TIUL)
N IDDAD
S IDDAD=+$P(TIUGDATA,U,3)
; ---- If Browsed Record is an ID Note, & this cycle has
; just loaded the parent entry, then load ID kids
; and quit: **100** ----
I $P(TIUGDATA,U,2),TIUDA=+TIUGDATA D LOADKIDS(TIUDA,.TIUL,TIUGDATA) Q
; ---- If Browsed Record is an ID Entry, & this cycle hasn't begun
; loading the whole note, then load the whole ID Note after
; the browsed entry and quit: ----
I IDDAD,'$G(TIUGWHOL) D Q
. S TIUGWHOL=1
. N TIULINE S $P(TIULINE,"=",79)=""
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
. S TIUL=TIUL+1,@TIUARR@(TIUL)=TIULINE
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
. S TIUL=TIUL+1,@TIUARR@(TIUL)=" --- Interdisciplinary Note ---"
. S TIUL=TIUL+1,@TIUARR@(TIUL)=""
. D LOADID(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
; ---- If Browsed Record is an ID Entry, & this cycle has begun
; loading the whole ID note, and is currently loading the first
; entry of the whole note, then load kids and quit: ----
I IDDAD,$G(TIUGWHOL),TIUDA=IDDAD D LOADKIDS(TIUDA,.TIUL,TIUGDATA,TIUGWHOL) K TIUGWHOL
Q
;
LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
; Requires TIUDA, array TIUL, TIUGDATA
N TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
I $G(^TMP("TIUR",$J,"IDDATA",TIUDA)) S PRMSORT=$P(^TMP("TIUR",$J,"IDDATA",TIUDA),U,4)
E S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUD21=$G(^TIU(8925,TIUDA,21)),PRMSORT=$P($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
D GETIDKID^TIURECL2(TIUDA,PRMSORT) ; sets array ^TMP("TIUIDKID",$J,
S TIUK=0
F S TIUK=$O(^TMP("TIUIDKID",$J,TIUDA,TIUK)) Q:+TIUK'>0 D
. S KIDDA=^TMP("TIUIDKID",$J,TIUDA,TIUK)
. D LOADID(KIDDA,.TIUL,TIUGDATA,$G(TIUGWHOL))
K ^TMP("TIUIDKID",$J)
Q
;
LOADID(TIUDA,TIUL,TIUGDATA,TIUWHOL) ; Load ID note for browse
N TIUREC,TIU
I '$D(^TIU(8925,+TIUDA,0)) Q
; ---- If ID Kid has focus, don't show it again ----
; I TIUDA=+$G(^TMP("TIU FOCUS",$J)) Q
S TIUL=TIUL+1,@TIUARR@(TIUL)=""
D GETTIU^TIULD(.TIU,+TIUDA)
D INQUIRE(TIUDA,.TIUREC)
; ---- Load info missing from header since this is ID note entry: ----
; ---- Load dictation, transcription data, etc.: ----
D LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,$G(TIUGDATA))
; ---- Load the remainder of the record: ----
D LOADREC(TIUDA,.TIUL,$G(TIUGDATA),$G(TIUWHOL))
Q
;
INQUIRE(TIUDA,TIUREC,TIUCPF) ; Inquire to document TIUDA and set TIUREC
N DA,DIC,DIQ,DR
S DA=TIUDA,DIC=8925,DIQ="TIUREC("
S DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506;89261"
;If the document is a member of the Clinical Procedures Class, include the
;Procedure Summary Code field and the Date/Time Performed field
I $G(TIUCPF) S DR=DR_";70201;70202"
D EN^DIQ1
Q
LOADADD(TIUDADD,TIUL) ; Load addenda
N TIUDAUTH,TIUDATT,TIUJ,TIUSIG,TIUCSIG,TIUVIEW
S TIUL=TIUL+1,@TIUARR@(TIUL)=""
S TIUDADT=$$DATE^TIULS($P($G(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD) ;P162
S TIUVIEW=$$CANDO^TIULP(+TIUDADD,"VIEW")
I '+TIUVIEW D Q
. S TIUL=TIUL+1,@TIUARR@(TIUL)=$P(TIUVIEW,U,2)
S TIUJ=0
F S TIUJ=$O(^TIU(8925,+TIUDADD,"TEXT",TIUJ)) Q:+TIUJ'>0 D
. S TIUL=TIUL+1,@TIUARR@(TIUL)=$G(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0))
D LOADSIG^TIUSRVR3(TIUDADD,.TIUL)
Q
TIUSRVR2 ; SLC/JER - RPC for record-wise GET ; 11/23/07
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**100,109,162,222,234**;Jun 20, 1997;Build 6
+2 ; 4/12/01 Moved signature modules to new rtn TIUSRVR3
LOADREC(TIUDA,TIUL,TIUGDATA,TIUGWHOL,ACTION) ; Load ^TMP
+1 ;Requires TIUDA, array TIUL, TIUGDATA
+2 ;optional TIUGWHOL = 1 if we're mid-load for browse, and we're already
+3 ; loading the whole note after the original entry,
+4 ; so DON'T load the whole note again.
+5 NEW TIUKID,TIUDADT,TIUI,CANSEE
+6 NEW TIUPARNT,TIUPNAME,TIUPDATE
+7 NEW TIUGPRNT,TIUGPNM,TIUGPDT,TIUPDATA,TIUHASKD
+8 SET ACTION=$GET(ACTION,"VIEW")
+9 ; ---- If user cannot view, say so and quit: ----
+10 ; TIU*1*100
+11 SET CANSEE=$SELECT(+$$ISCOMP^TIUSRVR1(TIUDA)>0:1,1:$$CANDO^TIULP(+TIUDA,ACTION))
+12 IF +CANSEE'>0
Begin DoDot:1
+13 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=$PIECE(CANSEE,U,2)
End DoDot:1
QUIT
+14 ; ---- Load text of TIUDA: ----
+15 SET TIUI=0
+16 FOR
SET TIUI=$ORDER(^TIU(8925,+TIUDA,"TEXT",TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+17 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=$GET(^TIU(8925,+TIUDA,"TEXT",+TIUI,0))
End DoDot:1
+18 ; ---- if TIUDA is a COMPONENT, QUIT
+19 IF +$$ISCOMP^TIUSRVR1(TIUDA)
QUIT
+20 ; ---- If TIUDA **IS** an addendum, load addm signature,
+21 ; load original document, quit: ----
+22 IF +$$ISADDNDM^TIULC1(+TIUDA)
Begin DoDot:1
+23 NEW TIULINE,TIUPARNT
SET $PIECE(TIULINE,"=",79)=""
+24 DO LOADSIG^TIUSRVR3(TIUDA,.TIUL)
+25 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
+26 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIULINE
+27 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
+28 SET TIUPARNT=+$PIECE(^TIU(8925,+TIUDA,0),U,6)
+29 SET TIUPNAME=$$PNAME^TIULC1(+^TIU(8925,TIUPARNT,0))
+30 SET TIUPDATE=+$GET(^TIU(8925,TIUPARNT,13))
+31 SET TIUPDATE=$$DATE^TIULS(TIUPDATE,"MM/DD/YY")
+32 SET TIUPDATA=$$IDDATA^TIURECL1(TIUPARNT)
+33 SET TIUHASKD=$PIECE(TIUPDATA,U,2)
SET TIUGPRNT=+$PIECE(TIUPDATA,U,3)
+34 SET TIUL=+$GET(TIUL)+1
+35 IF TIUHASKD
Begin DoDot:2
+36 SET @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
End DoDot:2
+37 IF TIUGPRNT
Begin DoDot:2
+38 SET @TIUARR@(TIUL)=" --- Original Addended Interdisciplinary Entry ---"
+39 SET TIUGPNM=$$PNAME^TIULC1(+^TIU(8925,TIUGPRNT,0))
+40 SET TIUGPDT=+$GET(^TIU(8925,TIUGPRNT,13))
+41 SET TIUGPDT=$$DATE^TIULS(TIUGPDT,"MM/DD/YY")
End DoDot:2
+42 IF 'TIUHASKD
IF 'TIUGPRNT
SET @TIUARR@(TIUL)=" --- Original Document ---"
+43 SET TIUL=+$GET(TIUL)+1
SET @TIUARR@(TIUL)=""
+44 SET TIUL=+$GET(TIUL)+1
+45 IF TIUHASKD
Begin DoDot:2
+46 SET @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>"
+47 SET TIUL=+$GET(TIUL)+1
+48 SET @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
End DoDot:2
+49 IF TIUGPRNT
Begin DoDot:2
+50 SET @TIUARR@(TIUL)=" << Interdisciplinary Note >>"
+51 SET TIUL=+$GET(TIUL)+1
+52 SET @TIUARR@(TIUL)=TIUGPDT_" "_TIUGPNM
+53 SET TIUL=+$GET(TIUL)+1
+54 SET @TIUARR@(TIUL)=" << Addended Interdisciplinary Entry >>"
+55 SET TIUL=+$GET(TIUL)+1
SET @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
End DoDot:2
+56 IF 'TIUHASKD
IF 'TIUGPRNT
Begin DoDot:2
+57 SET @TIUARR@(TIUL)=TIUPDATE_" "_TIUPNAME_":"
End DoDot:2
+58 DO LOADREC(TIUPARNT,.TIUL,TIUGDATA)
End DoDot:1
QUIT
+59 ; ---- Load components of TIUDA: ----
+60 SET TIUKID=0
+61 FOR
SET TIUKID=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUKID))
IF +TIUKID'>0
QUIT
Begin DoDot:1
+62 IF +$$ISADDNDM^TIULC1(TIUKID)'>0
DO LOADREC(TIUKID,.TIUL,$GET(TIUGDATA))
End DoDot:1
+63 ; ---- Load signature of TIUDA if TIUDA is not addm
+64 ; or comp: ----
+65 ; *222 don't display sig info. for FORM LETTERS
+66 IF '+$$MEMBEROF^TIUPR222(+$GET(^TIU(8925,+TIUDA,0)),"FORM LETTERS")
Begin DoDot:1
+67 IF '$$ISCOMP^TIUSRVR1(TIUDA)
DO LOADSIG^TIUSRVR3(TIUDA,.TIUL)
End DoDot:1
+68 ; ---- Load addenda of TIUDA: ----
+69 SET TIUKID=0
+70 FOR
SET TIUKID=$ORDER(^TIU(8925,"DAD",+TIUDA,TIUKID))
IF +TIUKID'>0
QUIT
Begin DoDot:1
+71 ; If acting on an addendum, don't show it again.
+72 IF +TIUKID=+$GET(^TMP("TIU FOCUS",$JOB))
QUIT
+73 IF +$$ISADDNDM^TIULC1(TIUKID)
DO LOADADD(TIUKID,.TIUL)
End DoDot:1
+74 NEW IDDAD
+75 SET IDDAD=+$PIECE(TIUGDATA,U,3)
+76 ; ---- If Browsed Record is an ID Note, & this cycle has
+77 ; just loaded the parent entry, then load ID kids
+78 ; and quit: **100** ----
+79 IF $PIECE(TIUGDATA,U,2)
IF TIUDA=+TIUGDATA
DO LOADKIDS(TIUDA,.TIUL,TIUGDATA)
QUIT
+80 ; ---- If Browsed Record is an ID Entry, & this cycle hasn't begun
+81 ; loading the whole note, then load the whole ID Note after
+82 ; the browsed entry and quit: ----
+83 IF IDDAD
IF '$GET(TIUGWHOL)
Begin DoDot:1
+84 SET TIUGWHOL=1
+85 NEW TIULINE
SET $PIECE(TIULINE,"=",79)=""
+86 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
+87 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIULINE
+88 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
+89 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=" --- Interdisciplinary Note ---"
+90 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
+91 DO LOADID(IDDAD,.TIUL,TIUGDATA,TIUGWHOL)
End DoDot:1
QUIT
+92 ; ---- If Browsed Record is an ID Entry, & this cycle has begun
+93 ; loading the whole ID note, and is currently loading the first
+94 ; entry of the whole note, then load kids and quit: ----
+95 IF IDDAD
IF $GET(TIUGWHOL)
IF TIUDA=IDDAD
DO LOADKIDS(TIUDA,.TIUL,TIUGDATA,TIUGWHOL)
KILL TIUGWHOL
+96 QUIT
+97 ;
LOADKIDS(TIUDA,TIUL,TIUGDATA,TIUGWHOL) ; Load ID kids of TIUDA
+1 ; Requires TIUDA, array TIUL, TIUGDATA
+2 NEW TIUK,PRMSORT,KIDDA,TIUD0,TIUD21
+3 IF $GET(^TMP("TIUR",$JOB,"IDDATA",TIUDA))
SET PRMSORT=$PIECE(^TMP("TIUR",$JOB,"IDDATA",TIUDA),U,4)
+4 IF '$TEST
SET TIUD0=$GET(^TIU(8925,TIUDA,0))
SET TIUD21=$GET(^TIU(8925,TIUDA,21))
SET PRMSORT=$PIECE($$IDDATA^TIURECL1(TIUDA,TIUD0,TIUD21),U,4)
+5 ; sets array ^TMP("TIUIDKID",$J,
DO GETIDKID^TIURECL2(TIUDA,PRMSORT)
+6 SET TIUK=0
+7 FOR
SET TIUK=$ORDER(^TMP("TIUIDKID",$JOB,TIUDA,TIUK))
IF +TIUK'>0
QUIT
Begin DoDot:1
+8 SET KIDDA=^TMP("TIUIDKID",$JOB,TIUDA,TIUK)
+9 DO LOADID(KIDDA,.TIUL,TIUGDATA,$GET(TIUGWHOL))
End DoDot:1
+10 KILL ^TMP("TIUIDKID",$JOB)
+11 QUIT
+12 ;
LOADID(TIUDA,TIUL,TIUGDATA,TIUWHOL) ; Load ID note for browse
+1 NEW TIUREC,TIU
+2 IF '$DATA(^TIU(8925,+TIUDA,0))
QUIT
+3 ; ---- If ID Kid has focus, don't show it again ----
+4 ; I TIUDA=+$G(^TMP("TIU FOCUS",$J)) Q
+5 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
+6 DO GETTIU^TIULD(.TIU,+TIUDA)
+7 DO INQUIRE(TIUDA,.TIUREC)
+8 ; ---- Load info missing from header since this is ID note entry: ----
+9 ; ---- Load dictation, transcription data, etc.: ----
+10 DO LOADTOP^TIUSRVR1(.TIUREC,TIUDA,.TIUL,$GET(TIUGDATA))
+11 ; ---- Load the remainder of the record: ----
+12 DO LOADREC(TIUDA,.TIUL,$GET(TIUGDATA),$GET(TIUWHOL))
+13 QUIT
+14 ;
INQUIRE(TIUDA,TIUREC,TIUCPF) ; Inquire to document TIUDA and set TIUREC
+1 NEW DA,DIC,DIQ,DR
+2 SET DA=TIUDA
SET DIC=8925
SET DIQ="TIUREC("
+3 SET DR=".01;.02;.05;.09;1201;1202;1208;1209;1301;1307;1501;1502;1505;1506;89261"
+4 ;If the document is a member of the Clinical Procedures Class, include the
+5 ;Procedure Summary Code field and the Date/Time Performed field
+6 IF $GET(TIUCPF)
SET DR=DR_";70201;70202"
+7 DO EN^DIQ1
+8 QUIT
LOADADD(TIUDADD,TIUL) ; Load addenda
+1 NEW TIUDAUTH,TIUDATT,TIUJ,TIUSIG,TIUCSIG,TIUVIEW
+2 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=""
+3 SET TIUDADT=$$DATE^TIULS($PIECE($GET(^TIU(8925,+TIUDADD,13)),U),"MM/DD/CCYY")
+4 ;P162
SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUDADT_" ADDENDUM"_" STATUS: "_$$STATUS^TIULF(TIUDADD)
+5 SET TIUVIEW=$$CANDO^TIULP(+TIUDADD,"VIEW")
+6 IF '+TIUVIEW
Begin DoDot:1
+7 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=$PIECE(TIUVIEW,U,2)
End DoDot:1
QUIT
+8 SET TIUJ=0
+9 FOR
SET TIUJ=$ORDER(^TIU(8925,+TIUDADD,"TEXT",TIUJ))
IF +TIUJ'>0
QUIT
Begin DoDot:1
+10 SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=$GET(^TIU(8925,+TIUDADD,"TEXT",TIUJ,0))
End DoDot:1
+11 DO LOADSIG^TIUSRVR3(TIUDADD,.TIUL)
+12 QUIT
