BTIUSRVT.m

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