PXRMDUTL ;SLC/AGP - DIALOG UTILITIES. ;07/22/2020
;;2.0;CLINICAL REMINDERS;**24,26,53,45,71**;Feb 04, 2005;Build 43
Q
;
;==========================================
ALLOWDEL(IEN) ; check to see if the item can be deleted
N CLASS,TYPE
S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
S CLASS=$P($G(^PXRMD(801.41,IEN,100)),U)
I (CLASS="N")&((TYPE="P")!(TYPE="F")) Q 0
Q 1
;
DELD(DIEN) ; delete the dialog item
N ARRAY,CNT,DARRAY,DA,DIK,PXRMINST
S CNT=0
D DITEMAR(DIEN,.ARRAY,.DARRAY,.CNT)
S PXRMINST=1
S DIK="^PXRMD(801.41,"
S CNT="" F S CNT=$O(ARRAY(CNT),-1) Q:CNT="" D
.S DA=$O(ARRAY(CNT,"")) Q:DA'>0
.I $$ALLOWDEL(DA)=0 Q
.D ^DIK
Q
;
; builds an array of items beneath the dialog item, lowest item first.
DITEMAR(DIEN,ARRAY,DARRAY,DCNT) ;
; DIEN is the IEN of the dialog top level
; Array contains the dialog elements and groups within the dialog.
N CNT,IDX,IEN,REPIEN,SEQ,TYPE,X0
S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0 D
.S IEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2) Q:IEN'>0
.I $D(^PXRMD(801.41,IEN,"BL")) D
..S SEQ=0 F S SEQ=$O(^PXRMD(801.41,IEN,"BL","B",SEQ)) Q:SEQ'>0 D
...S IDX=$O(^PXRMD(801.41,IEN,"BL","B",SEQ,"")) Q:IDX'>0
...S REPIEN=$P($G(^PXRMD(801.41,IEN,"BL",IDX,0)),U,5)
...I REPIEN>0 D DITEMAR(REPIEN,.ARRAY,.DARRAY,.DCNT)
.S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
.I TYPE="G"!(TYPE="E") D DITEMAR(IEN,.ARRAY,.DARRAY,.DCNT)
.I '$D(DARRAY(IEN)) S DARRAY(IEN)="",DCNT=DCNT+1,ARRAY(DCNT,IEN)=""
I '$D(DARRAY(DIEN)) S DARRAY(DIEN)="",DCNT=DCNT+1,ARRAY(DCNT,DIEN)=""
Q
;
DMAKENAT(DA) ; sets the class field and renamed to the correct national format
N CLASS,DIE,DR,IEN,NAME,NEWNAME,PREFIX,TYPE
S NAME=$P($G(^PXRMD(801.41,DA,0)),U)
I $E(NAME,1,3)="VA-"!($E(NAME,1,4)="PXRM") Q
S CLASS="N"
S DIE="^PXRMD(801.41,"
S DR="100////^S X=CLASS"
D ^DIE
S TYPE=$P($G(^PXRMD(801.41,DA,0)),U,4)
S PREFIX=$S(TYPE="R":"VA-",TYPE="G":"VA-",TYPE="E":"VA-",1:"PXRM ")
S NEWNAME=PREFIX_NAME
D RENAME^PXRMUTIL(801.41,NAME,NEWNAME)
Q
;
;=============================================================
; Build a TEMP global of findings for dialog types
; Input a string of characters for the dialog type field.
; example "EGS" = search element, groups, result groups
; Output an array by finding types, Finding IEN, Dialog IEN, "F" or "A"
; example OUT("AUTTHF(",608,631,"F")=""
FARRAY(SUB,TYPES) ;
N AFIEN,AFIND,DIEN,FIND,IDX,NODE,OI,TYPE,X
K ^TMP($J,SUB)
F X=1:1:$L(TYPES) S TYPE=$E(TYPES,X) D
.S DIEN=""
.F S DIEN=$O(^PXRMD(801.41,"TYPE",TYPE,DIEN)) Q:DIEN'>0 D
..I TYPE="S" D Q
...S FIND=$P($G(^PXRMD(801.41,DIEN,50)),U)
...I FIND'="" D SETGBL(SUB,DIEN,FIND_";YTT(601.71,","RG",0)
..S NODE=$G(^PXRMD(801.41,DIEN,1))
..S FIND=$P(NODE,U,5),OI=$P(NODE,U,7)
..I FIND'="" D SETGBL(SUB,DIEN,FIND,"F",0)
..I OI'="" D SETGBL(SUB,DIEN,OI_";ORD(101.43,","O",0)
..S AFIND=""
..F S AFIND=$O(^PXRMD(801.41,DIEN,3,"B",AFIND)) Q:AFIND="" D
...S AFIEN=$O(^PXRMD(801.41,DIEN,3,"B",AFIND,""))
...D SETGBL(SUB,DIEN,AFIND,"A",AFIEN)
..S IDX=0 F S IDX=$O(^PXRMD(801.41,DIEN,"BL",IDX)) Q:IDX'>0 D
...S NODE=$G(^PXRMD(801.41,DIEN,"BL",IDX,0))
...S FIND=$P(NODE,U,2),SEQ=$P(NODE,U)
...D SETGBL(SUB,DIEN,FIND,"B",SEQ)
Q
;
RTAXNAME(NAME) ;
I '$D(^PXD(811.2,"B",NAME)) Q NAME
N CNT,FOUND,RESULT,TEMP
S TEMP=NAME,CNT=0
I $L(NAME)>64 S TEMP=$E(NAME,1,60)
S TEMP=TEMP_"*"
I '$D(^PXD(811.2,"B",TEMP)) Q TEMP
S FOUND=0
F D Q:FOUND=1
.S CNT=CNT+1
.I '$D(^PXD(811.2,"B",TEMP_CNT)) S RESULT=TEMP_CNT,FOUND=1
Q RESULT
;
SETGBL(SUB,DIEN,VARP,LOC,IEN) ;
N FIEN,GBL
S GBL=$P(VARP,";",2),FIEN=$P(VARP,";")
I LOC="A" S ^TMP($J,SUB,GBL,FIEN,DIEN,LOC,IEN)="" Q
S ^TMP($J,SUB,GBL,FIEN,DIEN,LOC)=""
Q
;
NATCONV(DIEN) ; entry point to convert a local dialog to a national dialog
N ARRAY,IEN,DARRAY,DCNT
S DCNT=0
D DITEMAR(DIEN,.ARRAY,.DARRAY,.DCNT)
S IEN=0 F S IEN=$O(DARRAY(IEN)) Q:IEN'>0 D
.D DMAKENAT(IEN)
D DMAKENAT(DIEN)
Q
;
LINK2TIU(DNAME,TNAME,TEMPNAME,TEMPONLY,GBL) ;
;; DNAME=DIALOG NAME
;; TNAME=TIU TITLE NAME
;; TEMPNAME=FILE 8927 ENTRY NAME. If not defined the name is set to DNAME
;; TEMPONLY=1 PLACE ITEM UNDER SHARED TEMPLATES ROOT, 0=PLACE ITEM UNDER DOCUMENT TITLES ROOT
;; GBL=GLOBAL FOR LINK FIELD IN FILE 8927
N DA,DIE,DIEN,DR,FDA,IENS,LASTVAL,LINK,LVL,NAME,PAR,PXRMERR,PXRMPAR,SIEN
N TEMPIEN,TEXT,TIU,TYPE,DONE,TIEN,MSG,INST,OK,PREIEN,SINDEX,FLAG
; find dialog
S TEXT(1)="Template not created"
S NAME=$S($G(TEMPNAME)'="":TEMPNAME,1:DNAME)
S DIEN=$O(^PXRMD(801.41,"B",DNAME,""))
I DIEN'>0 S TEXT(2)=" Could not find dialog: "_DNAME D MES^XPDUTL(.TEXT) Q
I $P($G(^PXRMD(801.41,DIEN,0)),U,4)'="R" S TEXT(2)=" "_DNAME_"type is not a dialog" D MES^XPDUTL(.TEXT) Q
;find note title IEN
I +TEMPONLY=0 D
.S TIEN=0,DONE=0 F S TIEN=$O(^TIU(8925.1,"B",TNAME,"")) Q:TIEN'>0!(DONE=1) D
..S TYPE=$P($G(^TIU(8925.1,TIEN,0)),U,4) I TYPE="DOC" S DONE=1
.I TIEN'>0 S TEXT(2)=" Could not find note title: "_TNAME D MES^XPDUTL(.TEXT) Q
;
;set parameter value to true OK=0 means entity/value pair already exists.
S PAR="TIU TEMPLATE REMINDER DIALOGS",LVL="SYS",OK=1
D GETLST^XPAR(.PXRMPAR,LVL,PAR,"I",.PXRMERR)
S LASTVAL=$O(PXRMPAR(""),-1)
;F INST=1:1:LASTVAL D Q:INST>LASTVAL!(OK=0)
;. Q:'$D(PXRMPAR(INST))
S INST=0 F S INST=$O(PXRMPAR(INST)) Q:INST'>0!(OK=0) D
. I PXRMPAR(INST)=DIEN S OK=0
I OK=1 D
. S LASTVAL=LASTVAL+1
. D EN^XPAR(LVL,PAR,LASTVAL,"`"_DIEN,.PXRMERR)
;
;find template root IEN
I +$G(TEMPONLY)=1 S SIEN=$O(^TIU(8927,"AROOT","ROOT",""))
E S SIEN=$O(^TIU(8927,"AROOT","TITLES",""))
I SIEN'>0 S TEXT(2)=" Could not find "_$S(+$G(TEMPONLY)=1:"Shared Templates",1:"Document Titles")_" folder" D MES^XPDUTL(.TEXT) Q
;check for pre-existing template?
S PREIEN=$O(^TIU(8927,"B",$S($G(TEMPNAME)'="":TEMPNAME,1:DNAME)_" TEMPLATE","")),FLAG=1
I +$G(PREIEN)>0 D
. S SINDEX=0
. F S SINDEX=$O(^TIU(8927,SIEN,10,SINDEX)) Q:+$G(SINDEX)'>0!(FLAG=0) D
. . I $P(^TIU(8927,SIEN,10,SINDEX,0),U)=SINDEX&($P(^TIU(8927,SIEN,10,SINDEX,0),U,2)=PREIEN) S FLAG=0 D
. . . ;K MSG
. . . S TEXT(2)=" "_NAME_" template already exists under ",TEXT(3)=" "_$S(+$G(TEMPONLY)=1:"Shared Templates",1:"Document Titles")_" folder"
. . . D MES^XPDUTL(.TEXT)
. . . ;K MSG
Q:FLAG=0
;create linking template to dialog
S IENS="?+1,"
S FDA(8927,IENS,.01)=NAME
S FDA(8927,IENS,.03)="TEMPLATE"
S FDA(8927,IENS,.04)="ACTIVE"
S FDA(8927,IENS,.05)="NO"
S FDA(8927,IENS,.08)="NO"
S FDA(8927,IENS,.09)="NO"
S FDA(8927,IENS,.1)="NO"
S FDA(8927,IENS,.11)="NO"
S FDA(8927,IENS,.12)="NO"
S FDA(8927,IENS,.13)="NO"
S FDA(8927,IENS,.14)="NO"
S FDA(8927,IENS,.15)=DNAME
D UPDATE^DIE("E","FDA","IENS","MSG")
I $D(MSG)>0 S TEXT(2)=" Could not find "_DNAME_" template IEN" D MES^XPDUTL(.TEXT) D AWRITE^PXRMUTIL("MSG") Q
S TEMPIEN=IENS(1) I TEMPIEN'>0 S TEXT(2)=" Could not find "_DNAME_" template IEN" D MES^XPDUTL(.TEXT) Q
D MES^XPDUTL("Template "_NAME_" created")
;
;assign link template to Shared Template
K IENS,FDA
S LASTVAL=$O(^TIU(8927,SIEN,10,"B",""),-1)
S LASTVAL=LASTVAL+1
S FDA(8927.03,"+2,"_SIEN_",",.01)=LASTVAL
S FDA(8927.03,"+2,"_SIEN_",",.02)=TEMPIEN
D UPDATE^DIE("","FDA","","MSG")
I $D(MSG)>0 D
.S TEXT(2)=" Error adding "_DNAME_" Template to the "_$S(+$G(TEMPONLY)=1:"Shared Templates",1:"Document Titles")_" folder"
.D MES^XPDUTL(.TEXT) D AWRITE^PXRMUTIL("MSG") Q
I +$G(TEMPONLY)=1 D MES^XPDUTL("Template "_NAME_" added to Shared Folder.") Q
;
;assign note title to template
S DA=TEMPIEN,DIE="^TIU(8927,"
S LINK=TIEN_";"_GBL
S DR=".19////^S X=LINK"
D ^DIE
D MES^XPDUTL("Template "_NAME_" link to note title "_TNAME)
K FDA,IENS
S IENS=TEMPIEN_","
S FDA(8927,IENS,.01)=TNAME
D UPDATE^DIE("E","FDA","IENS","MSG")
I $D(MSG)>0 D
.S TEXT(1)="Could not rename template"
.D MES^XPDUTL(.TEXT) D AWRITE^PXRMUTIL("MSG")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDUTL 7997 printed Apr 09, 2024@20:53 Page 2
PXRMDUTL ;SLC/AGP - DIALOG UTILITIES. ;07/22/2020
+1 ;;2.0;CLINICAL REMINDERS;**24,26,53,45,71**;Feb 04, 2005;Build 43
+2 QUIT
+3 ;
+4 ;==========================================
ALLOWDEL(IEN) ; check to see if the item can be deleted
+1 NEW CLASS,TYPE
+2 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+3 SET CLASS=$PIECE($GET(^PXRMD(801.41,IEN,100)),U)
+4 IF (CLASS="N")&((TYPE="P")!(TYPE="F"))
QUIT 0
+5 QUIT 1
+6 ;
DELD(DIEN) ; delete the dialog item
+1 NEW ARRAY,CNT,DARRAY,DA,DIK,PXRMINST
+2 SET CNT=0
+3 DO DITEMAR(DIEN,.ARRAY,.DARRAY,.CNT)
+4 SET PXRMINST=1
+5 SET DIK="^PXRMD(801.41,"
+6 SET CNT=""
FOR
SET CNT=$ORDER(ARRAY(CNT),-1)
if CNT=""
QUIT
Begin DoDot:1
+7 SET DA=$ORDER(ARRAY(CNT,""))
if DA'>0
QUIT
+8 IF $$ALLOWDEL(DA)=0
QUIT
+9 DO ^DIK
End DoDot:1
+10 QUIT
+11 ;
+12 ; builds an array of items beneath the dialog item, lowest item first.
DITEMAR(DIEN,ARRAY,DARRAY,DCNT) ;
+1 ; DIEN is the IEN of the dialog top level
+2 ; Array contains the dialog elements and groups within the dialog.
+3 NEW CNT,IDX,IEN,REPIEN,SEQ,TYPE,X0
+4 SET CNT=0
FOR
SET CNT=$ORDER(^PXRMD(801.41,DIEN,10,CNT))
if CNT'>0
QUIT
Begin DoDot:1
+5 SET IEN=$PIECE($GET(^PXRMD(801.41,DIEN,10,CNT,0)),U,2)
if IEN'>0
QUIT
+6 IF $DATA(^PXRMD(801.41,IEN,"BL"))
Begin DoDot:2
+7 SET SEQ=0
FOR
SET SEQ=$ORDER(^PXRMD(801.41,IEN,"BL","B",SEQ))
if SEQ'>0
QUIT
Begin DoDot:3
+8 SET IDX=$ORDER(^PXRMD(801.41,IEN,"BL","B",SEQ,""))
if IDX'>0
QUIT
+9 SET REPIEN=$PIECE($GET(^PXRMD(801.41,IEN,"BL",IDX,0)),U,5)
+10 IF REPIEN>0
DO DITEMAR(REPIEN,.ARRAY,.DARRAY,.DCNT)
End DoDot:3
End DoDot:2
+11 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+12 IF TYPE="G"!(TYPE="E")
DO DITEMAR(IEN,.ARRAY,.DARRAY,.DCNT)
+13 IF '$DATA(DARRAY(IEN))
SET DARRAY(IEN)=""
SET DCNT=DCNT+1
SET ARRAY(DCNT,IEN)=""
End DoDot:1
+14 IF '$DATA(DARRAY(DIEN))
SET DARRAY(DIEN)=""
SET DCNT=DCNT+1
SET ARRAY(DCNT,DIEN)=""
+15 QUIT
+16 ;
DMAKENAT(DA) ; sets the class field and renamed to the correct national format
+1 NEW CLASS,DIE,DR,IEN,NAME,NEWNAME,PREFIX,TYPE
+2 SET NAME=$PIECE($GET(^PXRMD(801.41,DA,0)),U)
+3 IF $EXTRACT(NAME,1,3)="VA-"!($EXTRACT(NAME,1,4)="PXRM")
QUIT
+4 SET CLASS="N"
+5 SET DIE="^PXRMD(801.41,"
+6 SET DR="100////^S X=CLASS"
+7 DO ^DIE
+8 SET TYPE=$PIECE($GET(^PXRMD(801.41,DA,0)),U,4)
+9 SET PREFIX=$SELECT(TYPE="R":"VA-",TYPE="G":"VA-",TYPE="E":"VA-",1:"PXRM ")
+10 SET NEWNAME=PREFIX_NAME
+11 DO RENAME^PXRMUTIL(801.41,NAME,NEWNAME)
+12 QUIT
+13 ;
+14 ;=============================================================
+15 ; Build a TEMP global of findings for dialog types
+16 ; Input a string of characters for the dialog type field.
+17 ; example "EGS" = search element, groups, result groups
+18 ; Output an array by finding types, Finding IEN, Dialog IEN, "F" or "A"
+19 ; example OUT("AUTTHF(",608,631,"F")=""
FARRAY(SUB,TYPES) ;
+1 NEW AFIEN,AFIND,DIEN,FIND,IDX,NODE,OI,TYPE,X
+2 KILL ^TMP($JOB,SUB)
+3 FOR X=1:1:$LENGTH(TYPES)
SET TYPE=$EXTRACT(TYPES,X)
Begin DoDot:1
+4 SET DIEN=""
+5 FOR
SET DIEN=$ORDER(^PXRMD(801.41,"TYPE",TYPE,DIEN))
if DIEN'>0
QUIT
Begin DoDot:2
+6 IF TYPE="S"
Begin DoDot:3
+7 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,50)),U)
+8 IF FIND'=""
DO SETGBL(SUB,DIEN,FIND_";YTT(601.71,","RG",0)
End DoDot:3
QUIT
+9 SET NODE=$GET(^PXRMD(801.41,DIEN,1))
+10 SET FIND=$PIECE(NODE,U,5)
SET OI=$PIECE(NODE,U,7)
+11 IF FIND'=""
DO SETGBL(SUB,DIEN,FIND,"F",0)
+12 IF OI'=""
DO SETGBL(SUB,DIEN,OI_";ORD(101.43,","O",0)
+13 SET AFIND=""
+14 FOR
SET AFIND=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND))
if AFIND=""
QUIT
Begin DoDot:3
+15 SET AFIEN=$ORDER(^PXRMD(801.41,DIEN,3,"B",AFIND,""))
+16 DO SETGBL(SUB,DIEN,AFIND,"A",AFIEN)
End DoDot:3
+17 SET IDX=0
FOR
SET IDX=$ORDER(^PXRMD(801.41,DIEN,"BL",IDX))
if IDX'>0
QUIT
Begin DoDot:3
+18 SET NODE=$GET(^PXRMD(801.41,DIEN,"BL",IDX,0))
+19 SET FIND=$PIECE(NODE,U,2)
SET SEQ=$PIECE(NODE,U)
+20 DO SETGBL(SUB,DIEN,FIND,"B",SEQ)
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
RTAXNAME(NAME) ;
+1 IF '$DATA(^PXD(811.2,"B",NAME))
QUIT NAME
+2 NEW CNT,FOUND,RESULT,TEMP
+3 SET TEMP=NAME
SET CNT=0
+4 IF $LENGTH(NAME)>64
SET TEMP=$EXTRACT(NAME,1,60)
+5 SET TEMP=TEMP_"*"
+6 IF '$DATA(^PXD(811.2,"B",TEMP))
QUIT TEMP
+7 SET FOUND=0
+8 FOR
Begin DoDot:1
+9 SET CNT=CNT+1
+10 IF '$DATA(^PXD(811.2,"B",TEMP_CNT))
SET RESULT=TEMP_CNT
SET FOUND=1
End DoDot:1
if FOUND=1
QUIT
+11 QUIT RESULT
+12 ;
SETGBL(SUB,DIEN,VARP,LOC,IEN) ;
+1 NEW FIEN,GBL
+2 SET GBL=$PIECE(VARP,";",2)
SET FIEN=$PIECE(VARP,";")
+3 IF LOC="A"
SET ^TMP($JOB,SUB,GBL,FIEN,DIEN,LOC,IEN)=""
QUIT
+4 SET ^TMP($JOB,SUB,GBL,FIEN,DIEN,LOC)=""
+5 QUIT
+6 ;
NATCONV(DIEN) ; entry point to convert a local dialog to a national dialog
+1 NEW ARRAY,IEN,DARRAY,DCNT
+2 SET DCNT=0
+3 DO DITEMAR(DIEN,.ARRAY,.DARRAY,.DCNT)
+4 SET IEN=0
FOR
SET IEN=$ORDER(DARRAY(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+5 DO DMAKENAT(IEN)
End DoDot:1
+6 DO DMAKENAT(DIEN)
+7 QUIT
+8 ;
LINK2TIU(DNAME,TNAME,TEMPNAME,TEMPONLY,GBL) ;
+1 ;; DNAME=DIALOG NAME
+2 ;; TNAME=TIU TITLE NAME
+3 ;; TEMPNAME=FILE 8927 ENTRY NAME. If not defined the name is set to DNAME
+4 ;; TEMPONLY=1 PLACE ITEM UNDER SHARED TEMPLATES ROOT, 0=PLACE ITEM UNDER DOCUMENT TITLES ROOT
+5 ;; GBL=GLOBAL FOR LINK FIELD IN FILE 8927
+6 NEW DA,DIE,DIEN,DR,FDA,IENS,LASTVAL,LINK,LVL,NAME,PAR,PXRMERR,PXRMPAR,SIEN
+7 NEW TEMPIEN,TEXT,TIU,TYPE,DONE,TIEN,MSG,INST,OK,PREIEN,SINDEX,FLAG
+8 ; find dialog
+9 SET TEXT(1)="Template not created"
+10 SET NAME=$SELECT($GET(TEMPNAME)'="":TEMPNAME,1:DNAME)
+11 SET DIEN=$ORDER(^PXRMD(801.41,"B",DNAME,""))
+12 IF DIEN'>0
SET TEXT(2)=" Could not find dialog: "_DNAME
DO MES^XPDUTL(.TEXT)
QUIT
+13 IF $PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)'="R"
SET TEXT(2)=" "_DNAME_"type is not a dialog"
DO MES^XPDUTL(.TEXT)
QUIT
+14 ;find note title IEN
+15 IF +TEMPONLY=0
Begin DoDot:1
+16 SET TIEN=0
SET DONE=0
FOR
SET TIEN=$ORDER(^TIU(8925.1,"B",TNAME,""))
if TIEN'>0!(DONE=1)
QUIT
Begin DoDot:2
+17 SET TYPE=$PIECE($GET(^TIU(8925.1,TIEN,0)),U,4)
IF TYPE="DOC"
SET DONE=1
End DoDot:2
+18 IF TIEN'>0
SET TEXT(2)=" Could not find note title: "_TNAME
DO MES^XPDUTL(.TEXT)
QUIT
End DoDot:1
+19 ;
+20 ;set parameter value to true OK=0 means entity/value pair already exists.
+21 SET PAR="TIU TEMPLATE REMINDER DIALOGS"
SET LVL="SYS"
SET OK=1
+22 DO GETLST^XPAR(.PXRMPAR,LVL,PAR,"I",.PXRMERR)
+23 SET LASTVAL=$ORDER(PXRMPAR(""),-1)
+24 ;F INST=1:1:LASTVAL D Q:INST>LASTVAL!(OK=0)
+25 ;. Q:'$D(PXRMPAR(INST))
+26 SET INST=0
FOR
SET INST=$ORDER(PXRMPAR(INST))
if INST'>0!(OK=0)
QUIT
Begin DoDot:1
+27 IF PXRMPAR(INST)=DIEN
SET OK=0
End DoDot:1
+28 IF OK=1
Begin DoDot:1
+29 SET LASTVAL=LASTVAL+1
+30 DO EN^XPAR(LVL,PAR,LASTVAL,"`"_DIEN,.PXRMERR)
End DoDot:1
+31 ;
+32 ;find template root IEN
+33 IF +$GET(TEMPONLY)=1
SET SIEN=$ORDER(^TIU(8927,"AROOT","ROOT",""))
+34 IF '$TEST
SET SIEN=$ORDER(^TIU(8927,"AROOT","TITLES",""))
+35 IF SIEN'>0
SET TEXT(2)=" Could not find "_$SELECT(+$GET(TEMPONLY)=1:"Shared Templates",1:"Document Titles")_" folder"
DO MES^XPDUTL(.TEXT)
QUIT
+36 ;check for pre-existing template?
+37 SET PREIEN=$ORDER(^TIU(8927,"B",$SELECT($GET(TEMPNAME)'="":TEMPNAME,1:DNAME)_" TEMPLATE",""))
SET FLAG=1
+38 IF +$GET(PREIEN)>0
Begin DoDot:1
+39 SET SINDEX=0
+40 FOR
SET SINDEX=$ORDER(^TIU(8927,SIEN,10,SINDEX))
if +$GET(SINDEX)'>0!(FLAG=0)
QUIT
Begin DoDot:2
+41 IF $PIECE(^TIU(8927,SIEN,10,SINDEX,0),U)=SINDEX&($PIECE(^TIU(8927,SIEN,10,SINDEX,0),U,2)=PREIEN)
SET FLAG=0
Begin DoDot:3
+42 ;K MSG
+43 SET TEXT(2)=" "_NAME_" template already exists under "
SET TEXT(3)=" "_$SELECT(+$GET(TEMPONLY)=1:"Shared Templates",1:"Document Titles")_" folder"
+44 DO MES^XPDUTL(.TEXT)
+45 ;K MSG
End DoDot:3
End DoDot:2
End DoDot:1
+46 if FLAG=0
QUIT
+47 ;create linking template to dialog
+48 SET IENS="?+1,"
+49 SET FDA(8927,IENS,.01)=NAME
+50 SET FDA(8927,IENS,.03)="TEMPLATE"
+51 SET FDA(8927,IENS,.04)="ACTIVE"
+52 SET FDA(8927,IENS,.05)="NO"
+53 SET FDA(8927,IENS,.08)="NO"
+54 SET FDA(8927,IENS,.09)="NO"
+55 SET FDA(8927,IENS,.1)="NO"
+56 SET FDA(8927,IENS,.11)="NO"
+57 SET FDA(8927,IENS,.12)="NO"
+58 SET FDA(8927,IENS,.13)="NO"
+59 SET FDA(8927,IENS,.14)="NO"
+60 SET FDA(8927,IENS,.15)=DNAME
+61 DO UPDATE^DIE("E","FDA","IENS","MSG")
+62 IF $DATA(MSG)>0
SET TEXT(2)=" Could not find "_DNAME_" template IEN"
DO MES^XPDUTL(.TEXT)
DO AWRITE^PXRMUTIL("MSG")
QUIT
+63 SET TEMPIEN=IENS(1)
IF TEMPIEN'>0
SET TEXT(2)=" Could not find "_DNAME_" template IEN"
DO MES^XPDUTL(.TEXT)
QUIT
+64 DO MES^XPDUTL("Template "_NAME_" created")
+65 ;
+66 ;assign link template to Shared Template
+67 KILL IENS,FDA
+68 SET LASTVAL=$ORDER(^TIU(8927,SIEN,10,"B",""),-1)
+69 SET LASTVAL=LASTVAL+1
+70 SET FDA(8927.03,"+2,"_SIEN_",",.01)=LASTVAL
+71 SET FDA(8927.03,"+2,"_SIEN_",",.02)=TEMPIEN
+72 DO UPDATE^DIE("","FDA","","MSG")
+73 IF $DATA(MSG)>0
Begin DoDot:1
+74 SET TEXT(2)=" Error adding "_DNAME_" Template to the "_$SELECT(+$GET(TEMPONLY)=1:"Shared Templates",1:"Document Titles")_" folder"
+75 DO MES^XPDUTL(.TEXT)
DO AWRITE^PXRMUTIL("MSG")
QUIT
End DoDot:1
+76 IF +$GET(TEMPONLY)=1
DO MES^XPDUTL("Template "_NAME_" added to Shared Folder.")
QUIT
+77 ;
+78 ;assign note title to template
+79 SET DA=TEMPIEN
SET DIE="^TIU(8927,"
+80 SET LINK=TIEN_";"_GBL
+81 SET DR=".19////^S X=LINK"
+82 DO ^DIE
+83 DO MES^XPDUTL("Template "_NAME_" link to note title "_TNAME)
+84 KILL FDA,IENS
+85 SET IENS=TEMPIEN_","
+86 SET FDA(8927,IENS,.01)=TNAME
+87 DO UPDATE^DIE("E","FDA","IENS","MSG")
+88 IF $DATA(MSG)>0
Begin DoDot:1
+89 SET TEXT(1)="Could not rename template"
+90 DO MES^XPDUTL(.TEXT)
DO AWRITE^PXRMUTIL("MSG")
End DoDot:1
+91 QUIT
+92 ;
