BTIUSRVT ; IHS/MSC/MGH - Server functions for group notes;30-Sep-2010 14:39;DU
;;1.0;TEXT INTEGRATION UTILITIES;**76,80,102,105,119,125,1007**;NOV 04, 2004;Build 5
;
; Nodes Returned by GETROOTS and GETITEMS
;
; Piece Data
; ----- ---------------------
; 1 IEN
; 2 TYPE
; 3 STATUS
; 4 NAME
; 5 EXCLUDE FROM GROUP BOILERPLATE
; 6 BLANK LINES
; 7 PERSONAL OWNER
; 8 HAS CHILDREN FLAG (0=NONE, 1=ACTIVE, 2=INACTIVE, 3=BOTH)
; 9 DIALOG
; 10 DISPLAY ONLY
; 11 FIRST LINE
; 12 ONE ITEM ONLY
; 13 HIDE DIALOG ITEMS
; 14 HIDE TREE ITEMS
; 15 INDENT ITEMS
; 16 REMINDER DIALOG IEN
; 17 REMINDER DIALOG NAME
; 18 LOCKED
; 19 COM OBJECT POINTER
; 20 COM OBJECT PARAMETER
; 21 LINK POINTER
GETROOTS(TIUY,USER) ;Get template root info
N IDX,TIUDA,TYPE,PARAM,ENT,ARY,ERR,LP
S PARAM="BTIU GROUP NOTES TEMPLATES"
S ENT=$$ENT^CIAVMRPC(PARAM,.ENT)
D GETLST^XPAR(.ARY,ENT,PARAM,"N",.ERR)
I $G(ERR) K ARY S DATA=ERR
S LP=0 F S LP=$O(ARY(LP)) Q:LP<1 D
.S TIUDA=$P(ARY(LP),U,1)
.D ADDNODE(.IDX,TIUDA,1)
Q
;
;
GETITEMS(TIUY,TIUDA) ;Return the list of templates that can be used for group notes
N IDX,ITEM,SEQ,ITEMNODE
K ^TMP("TIU TEMPLATE",$J)
S TIUY=$NA(^TMP("TIU TEMPLATE",$J))
S PARAM="BTIU GROUP NOTES TEMPLATES"
S ENT=$$ENT^CIAVMRPC(PARAM,.ENT)
D GETLST^XPAR(.ARY,ENT,PARAM,"N",.ERR)
I $G(ERR) K ARY S DATA=ERR
S LP=0 F S LP=$O(ARY(LP)) Q:LP<1 D
.S TIUDA=$P(ARY(LP),U,1)
.D ADDNODE(.IDX,TIUDA,1)
Q
GETTEXT(TIUY,DFN,VSTR,TIUX) ; Expand Boilerplate
D BLRPLT(.TIUY,"",DFN,VSTR,"TIUX")
Q
; Internal Routines
;
ADDNODE(IDX,TIUDA,INTIUY) ;Adds template node info
N DATA
S DATA=$$NODEDATA^TIUSRVT(TIUDA)
I DATA'="" D
.S IDX=$G(IDX)+1
.I $G(INTIUY) S TIUY(IDX)=DATA
.E S ^TMP("TIU TEMPLATE",$J,IDX)=DATA
Q
;
BLRPLT(TIUY,TITLE,DFN,VSTR,ROOT) ; Load/Execute the Boilerplate for TITLE
; or ROOT
N TIU,TIUI,TIUJ,TIUK,TIUL,VADM,VAIN,VA,VAERR S TIUI=0
;
;IHS/ITSC/LJF 12/16/2003 per CIA
;S:'$D(TIUY) TIUY=$NA(^TMP("TIUBOIL",$J))
S TIUY=$NA(^TMP("TIUBOIL",$J))
;
S:'$D(ROOT) ROOT=$NA(^TIU(8925.1,+TITLE,"DFLT")) ; **47**
I $L($G(VSTR)) D PATVADPT^TIULV(.TIU,DFN,"",$G(VSTR)) ; **47**
S TIUJ=+$P($G(^TMP("TIUBOIL",$J,0)),U,3)+1
; --- Set component header ---
I ROOT["^TIU(8925.1," D
. S ^TMP("TIUBOIL",$J,TIUJ,0)=$S($P($G(^TIU(8925.1,+TITLE,0)),U,4)="CO":$P(^TIU(8925.1,+TITLE,0),U)_": ",1:"")
I +TIUJ=1,($G(^TMP("TIUBOIL",$J,TIUJ,0))']"") K ^TMP("TIUBOIL",$J,TIUJ,0) S TIUJ=0
S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
F S TIUI=$O(@ROOT@(TIUI)) Q:+TIUI'>0 D
. S TIUJ=TIUJ+1
. S X=$G(@ROOT@(TIUI,0))
. ;I $L($T(DOLMLINE^TIUSRVF1)),'$D(XWBOS),(X["{FLD:") S X=$$DOLMLINE^TIUSRVF1(X)
. I X["|" S X=$$BOIL(X,TIUJ)
. I X["~@" D INSMULT^TIUSRVD(X,"^TMP(""TIUBOIL"",$J)",.TIUJ) I 1
. E S ^TMP("TIUBOIL",$J,TIUJ,0)=X
. S ^TMP("TIUBOIL",$J,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
I ROOT["^TIU(8925.1,",+$O(^TIU(8925.1,+TITLE,10,0)) D
. N TIUFITEM,TIUI D ITEMS^TIUFLT(+TITLE)
. S TIUI=0 F S TIUI=$O(TIUFITEM(TIUI)) Q:+TIUI'>0 D
. . S TIUL=+$G(TIUFITEM(+TIUI)) D BLRPLT(.TIUY,TIUL,DFN,$G(VSTR))
Q
BOIL(LINE,COUNT) ; Execute Boilerplates
N TIUI,DIC,X,Y,TIUFPRIV S TIUFPRIV=1
S DIC=8925.1,DIC(0)="FMXZ"
S DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
F TIUI=2:2:$L(LINE,"|") S X=$P(LINE,"|",TIUI) D
. S X="""Objects invalid in group notes."""
. S LINE=$$REPLACE(LINE,X,TIUI)
Q $TR(LINE,"|","")
REPLACE(LINE,X,TIUI) ; Replace the TIUIth object in LINE w/X
S $P(LINE,"|",TIUI)=X
Q LINE
BTIUSRVT ; IHS/MSC/MGH - Server functions for group notes;30-Sep-2010 14:39;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**76,80,102,105,119,125,1007**;NOV 04, 2004;Build 5
+2 ;
+3 ; Nodes Returned by GETROOTS and GETITEMS
+4 ;
+5 ; Piece Data
+6 ; ----- ---------------------
+7 ; 1 IEN
+8 ; 2 TYPE
+9 ; 3 STATUS
+10 ; 4 NAME
+11 ; 5 EXCLUDE FROM GROUP BOILERPLATE
+12 ; 6 BLANK LINES
+13 ; 7 PERSONAL OWNER
+14 ; 8 HAS CHILDREN FLAG (0=NONE, 1=ACTIVE, 2=INACTIVE, 3=BOTH)
+15 ; 9 DIALOG
+16 ; 10 DISPLAY ONLY
+17 ; 11 FIRST LINE
+18 ; 12 ONE ITEM ONLY
+19 ; 13 HIDE DIALOG ITEMS
+20 ; 14 HIDE TREE ITEMS
+21 ; 15 INDENT ITEMS
+22 ; 16 REMINDER DIALOG IEN
+23 ; 17 REMINDER DIALOG NAME
+24 ; 18 LOCKED
+25 ; 19 COM OBJECT POINTER
+26 ; 20 COM OBJECT PARAMETER
+27 ; 21 LINK POINTER
GETROOTS(TIUY,USER) ;Get template root info
+1 NEW IDX,TIUDA,TYPE,PARAM,ENT,ARY,ERR,LP
+2 SET PARAM="BTIU GROUP NOTES TEMPLATES"
+3 SET ENT=$$ENT^CIAVMRPC(PARAM,.ENT)
+4 DO GETLST^XPAR(.ARY,ENT,PARAM,"N",.ERR)
+5 IF $GET(ERR)
KILL ARY
SET DATA=ERR
+6 SET LP=0
FOR
SET LP=$ORDER(ARY(LP))
IF LP<1
QUIT
Begin DoDot:1
+7 SET TIUDA=$PIECE(ARY(LP),U,1)
+8 DO ADDNODE(.IDX,TIUDA,1)
End DoDot:1
+9 QUIT
+10 ;
+11 ;
GETITEMS(TIUY,TIUDA) ;Return the list of templates that can be used for group notes
+1 NEW IDX,ITEM,SEQ,ITEMNODE
+2 KILL ^TMP("TIU TEMPLATE",$JOB)
+3 SET TIUY=$NAME(^TMP("TIU TEMPLATE",$JOB))
+4 SET PARAM="BTIU GROUP NOTES TEMPLATES"
+5 SET ENT=$$ENT^CIAVMRPC(PARAM,.ENT)
+6 DO GETLST^XPAR(.ARY,ENT,PARAM,"N",.ERR)
+7 IF $GET(ERR)
KILL ARY
SET DATA=ERR
+8 SET LP=0
FOR
SET LP=$ORDER(ARY(LP))
IF LP<1
QUIT
Begin DoDot:1
+9 SET TIUDA=$PIECE(ARY(LP),U,1)
+10 DO ADDNODE(.IDX,TIUDA,1)
End DoDot:1
+11 QUIT
GETTEXT(TIUY,DFN,VSTR,TIUX) ; Expand Boilerplate
+1 DO BLRPLT(.TIUY,"",DFN,VSTR,"TIUX")
+2 QUIT
+3 ; Internal Routines
+4 ;
ADDNODE(IDX,TIUDA,INTIUY) ;Adds template node info
+1 NEW DATA
+2 SET DATA=$$NODEDATA^TIUSRVT(TIUDA)
+3 IF DATA'=""
Begin DoDot:1
+4 SET IDX=$GET(IDX)+1
+5 IF $GET(INTIUY)
SET TIUY(IDX)=DATA
+6 IF '$TEST
SET ^TMP("TIU TEMPLATE",$JOB,IDX)=DATA
End DoDot:1
+7 QUIT
+8 ;
BLRPLT(TIUY,TITLE,DFN,VSTR,ROOT) ; Load/Execute the Boilerplate for TITLE
+1 ; or ROOT
+2 NEW TIU,TIUI,TIUJ,TIUK,TIUL,VADM,VAIN,VA,VAERR
SET TIUI=0
+3 ;
+4 ;IHS/ITSC/LJF 12/16/2003 per CIA
+5 ;S:'$D(TIUY) TIUY=$NA(^TMP("TIUBOIL",$J))
+6 SET TIUY=$NAME(^TMP("TIUBOIL",$JOB))
+7 ;
+8 ; **47**
IF '$DATA(ROOT)
SET ROOT=$NAME(^TIU(8925.1,+TITLE,"DFLT"))
+9 ; **47**
IF $LENGTH($GET(VSTR))
DO PATVADPT^TIULV(.TIU,DFN,"",$GET(VSTR))
+10 SET TIUJ=+$PIECE($GET(^TMP("TIUBOIL",$JOB,0)),U,3)+1
+11 ; --- Set component header ---
+12 IF ROOT["^TIU(8925.1,"
Begin DoDot:1
+13 SET ^TMP("TIUBOIL",$JOB,TIUJ,0)=$SELECT($PIECE($GET(^TIU(8925.1,+TITLE,0)),U,4)="CO":$PIECE(^TIU(8925.1,+TITLE,0),U)_": ",1:"")
End DoDot:1
+14 IF +TIUJ=1
IF ($GET(^TMP("TIUBOIL",$JOB,TIUJ,0))']"")
KILL ^TMP("TIUBOIL",$JOB,TIUJ,0)
SET TIUJ=0
+15 SET ^TMP("TIUBOIL",$JOB,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
+16 FOR
SET TIUI=$ORDER(@ROOT@(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+17 SET TIUJ=TIUJ+1
+18 SET X=$GET(@ROOT@(TIUI,0))
+19 ;I $L($T(DOLMLINE^TIUSRVF1)),'$D(XWBOS),(X["{FLD:") S X=$$DOLMLINE^TIUSRVF1(X)
+20 IF X["|"
SET X=$$BOIL(X,TIUJ)
+21 IF X["~@"
DO INSMULT^TIUSRVD(X,"^TMP(""TIUBOIL"",$J)",.TIUJ)
IF 1
+22 IF '$TEST
SET ^TMP("TIUBOIL",$JOB,TIUJ,0)=X
+23 SET ^TMP("TIUBOIL",$JOB,0)="^^"_TIUJ_U_TIUJ_U_DT_"^^"
End DoDot:1
+24 IF ROOT["^TIU(8925.1,"
IF +$ORDER(^TIU(8925.1,+TITLE,10,0))
Begin DoDot:1
+25 NEW TIUFITEM,TIUI
DO ITEMS^TIUFLT(+TITLE)
+26 SET TIUI=0
FOR
SET TIUI=$ORDER(TIUFITEM(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:2
+27 SET TIUL=+$GET(TIUFITEM(+TIUI))
DO BLRPLT(.TIUY,TIUL,DFN,$GET(VSTR))
End DoDot:2
End DoDot:1
+28 QUIT
BOIL(LINE,COUNT) ; Execute Boilerplates
+1 NEW TIUI,DIC,X,Y,TIUFPRIV
SET TIUFPRIV=1
+2 SET DIC=8925.1
SET DIC(0)="FMXZ"
+3 SET DIC("S")="I $P($G(^TIU(8925.1,+Y,0)),U,4)=""O"""
+4 FOR TIUI=2:2:$LENGTH(LINE,"|")
SET X=$PIECE(LINE,"|",TIUI)
Begin DoDot:1
+5 SET X="""Objects invalid in group notes."""
+6 SET LINE=$$REPLACE(LINE,X,TIUI)
End DoDot:1
+7 QUIT $TRANSLATE(LINE,"|","")
REPLACE(LINE,X,TIUI) ; Replace the TIUIth object in LINE w/X
+1 SET $PIECE(LINE,"|",TIUI)=X
+2 QUIT LINE
