PXRMTXSM ;SLC/PKR - Reminder Taxonomy ScreenMan routines ;02-Nov-2015 08:55;du
;;2.0;CLINICAL REMINDERS;**26,1005**;Feb 04, 2005;Build 23
;
;===================================
CODELIST(TAXIEN,TERM,CODESYS) ;See if the temporary list of selected codes
;exists, if it does not and codes have been stored in the taxonomy
;then build it.
I $D(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q
I '$D(^PXD(811.2,TAXIEN,20,"ATC",TERM,CODESYS)) Q
M ^TMP("PXRMCODES",$J,TERM,CODESYS)=^PXD(811.2,TAXIEN,20,"ATCC",TERM,CODESYS)
Q
;
;===================================
EXETCCAP(DA) ;Executable caption for code search.
N TC
S TC=$$GET^DDSVAL(811.23,.DA,.01,"","E")
I $L(TC)>57 S TC=$E(TC,1,54)_"..."
Q " Term/Code: "_TC_" "
;
;===================================
LEXSRCH(DA,CODESYS) ;Branch for Lexicon Term/Code search.
;selection.
N PXRMLEXV,SAVEDDS,TAXIEN,TERM
;These PXRM variables are used in the List Manager Lexicon search.
N PXRMBGS,PXRMLEXV
K ^TMP("PXRMLEXTC",$J)
S ^TMP("PXRMLEXTC",$J,"CODESYS")=CODESYS
S (^TMP("PXRMLEXTC",$J,"LEX TERM"),TERM)=$$GET^DDSVAL(811.23,.DA,.01,"","E")
S (^TMP("PXRMLEXTC",$J,"TAX IEN"),TAXIEN)=DA(1)
D CODELIST(TAXIEN,TERM,CODESYS)
;DBIA #5746 covers kill and set of DDS.
I $D(DDS) S SAVEDDS=DDS K DDS
D EN^VALM("PXRM LEXICON SELECT")
K ^TMP("PXRMLEXTC",$J)
;Reset the screen so ScreenMan displays properly.
I $D(SAVEDDS) D
. N IOAWM0,X
. S DDS=SAVEDDS
. S X=0 X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD")
. S X="IOAWM0" D ENDR^%ZISS W IOAWM0
. D REFRESH^DDSUTL
Q
;
;===================================
LTCPAOC(DA) ;Lexicon Term/Code post-action on change.
N NTC,OTC,TEXT
S NTC=$$GET^DDSVAL(811.23,.DA,"TERM/CODE")
S OTC=$G(^PXD(811.2,DA(1),20,DA,0))
I ($L(OTC)>0),(NTC'=OTC) D
. S TEXT(1)="Overwriting a search Term/Code is not allowed!"
. S TEXT(2)="To replace a search term delete the existing one first."
. S TEXT(3)="$$EOP"
. D HLP^DDSUTL(.TEXT)
. D PUT^DDSVAL(811.23,.DA,"TERM/CODE",OTC)
Q
;
;===================================
NUMCODES(DA) ;Executable caption to display the number of selected codes
;for Lexicon Term/Code.
;^TMP("PXRMCODES",$J) will have the value from the current editing
;session so check it first.
I DA="" Q $$REPEAT^XLFSTR(" ",30)
N CODESYS,COUNT,IND,NUID,NUM,TEMP,TERM,TEXT,UID
S TERM=$$GET^DDSVAL(811.23,.DA,.01,"","E")
S CODESYS=""
F S CODESYS=$O(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q:CODESYS="" D
. S CODE="",(NUID,NUM)=0
. F S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE="" D
.. S NUM=NUM+1
.. S UID=^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
.. I UID=1 S NUID=NUID+1
. S COUNT(CODESYS)=NUM
. S NUID(CODESYS)=NUID
;Check for stored values.
S IND=0
F S IND=+$O(^PXD(811.2,DA(1),20,DA,1,IND)) Q:IND=0 D
. S TEMP=^PXD(811.2,DA(1),20,DA,1,IND,0)
. S CODESYS=$P(TEMP,U,1),NUM=$P(TEMP,U,2),NUID=$P(TEMP,U,3)
. I $D(COUNT(CODESYS))!(NUM=0) Q
. S COUNT(CODESYS)=NUM
. S NUID(CODESYS)=NUID
I '$D(COUNT) Q "None"_$$REPEAT^XLFSTR(" ",26)
S (CODESYS,TEXT)=""
F S CODESYS=$O(COUNT(CODESYS)) Q:CODESYS="" D
. S TEXT=TEXT_CODESYS_":"_COUNT(CODESYS)
. I NUID(CODESYS)>0 S TEXT=TEXT_":"_NUID(CODESYS)
. S TEXT=TEXT_" "
S NUM=$L(TEXT)
I NUM<30 S TEXT=TEXT_$$REPEAT^XLFSTR(" ",(30-NUM))
Q TEXT
;
;===================================
POSTACT(D0) ;Form Post Action
N INACTIVE,INUSE,OUTPUT
K ^TMP("PXRMCODES",$J)
;If the change was a deletion there is nothing else to do.
I '$D(^PXD(811.2,D0)) Q
;If the taxonomy was inactivated check to see if it is being used.
S INACTIVE=$$GET^DDSVAL(811.2,D0,"INACTIVE FLAG")
S INUSE=$S(INACTIVE:$$INUSE^PXRMTAXD(D0,"INACT"),1:0)
I INUSE D HLP^DDSUTL("$$EOP")
;Check for dialog problems.
D TAXEDITC^PXRMDTAX(D0,.OUTPUT)
I $D(OUTPUT) D
. ;IHS/MSC/MGH Newed Variables
. N IOSTBM,IORI
. D BROWSE^DDBR("OUTPUT","NR","Problems with dialogs using this taxonomy.")
. I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
Q
;
;===================================
POSTSAVE(IEN) ;Form Post Save. Store changes in lists of codes.
N CODE,CODESYS,CSYIND,FDA,KCSYSIND,KFDA,MSG,NSEL,NUID,PDS
N TEMP,TERM,TERMIND,TEXT,UID
S TERM="",TERMIND=0
F S TERM=$O(^TMP("PXRMCODES",$J,TERM)) Q:TERM="" D
.;If this term has been deleted, skip the rest.
. I '$D(^PXD(811.2,IEN,20,"B",TERM)) Q
. S TERMIND=$O(^PXD(811.2,IEN,20,"B",TERM,""))
. S CODESYS="",CSYSIND=TERMIND
. F S CODESYS=$O(^TMP("PXRMCODES",$J,TERM,CODESYS)) Q:CODESYS="" D
..;Check for existing entries for this term and this coding system.
..;If there are any remove them before storing the new set.
.. I $D(^PXD(811.2,IEN,20,"ATC",TERM,CODESYS)) D
... S KCSYSIND=$P(^PXD(811.2,IEN,20,"ATC",TERM,CODESYS),U,2)
... S IENS=KCSYSIND_","_TERMIND_","_IEN_","
... S KFDA(811.231,IENS,.01)="@"
... D FILE^DIE("","KFDA","MSG")
.. S CSYSIND=CSYSIND+1
.. S (NSEL,NUID)=0,CODE=""
.. F S CODE=$O(^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)) Q:CODE="" D
... S NSEL=NSEL+1
... S UID=^TMP("PXRMCODES",$J,TERM,CODESYS,CODE)
... I UID=1 S NUID=NUID+1
... S IENS="+"_(NSEL+CSYSIND)_",+"_CSYSIND_","_TERMIND_","_IEN_","
... S FDA(811.2312,IENS,.01)=CODE
... S FDA(811.2312,IENS,1)=UID
.. S IENS="+"_CSYSIND_","_TERMIND_","_IEN_","
.. S FDA(811.231,IENS,.01)=CODESYS
.. S FDA(811.231,IENS,1)=NSEL
.. S FDA(811.231,IENS,3)=NUID
.. S CSYSIND=NSEL+CSYSIND
. D UPDATE^DIE("","FDA","","MSG")
. I $D(MSG) D
.. S TEXT(1)="Error storing codes for term "_TERM
.. S TEXT(2)=" coding system "_CODESYS
.. D EN^DDIOL(.TEXT)
.. D AWRITE^PXRMUTIL("MSG")
.. H 2
K ^TMP("PXRMCODES",$J)
;Make sure Patient Data Source index is built.
S PDS=$$GET^DDSVAL(811.2,IEN,"PATIENT DATA SOURCE")
I PDS="" D SPDS^PXRMPDS(IEN,PDS)
Q
;
;===================================
SMANEDIT(IEN,NEW,FORM) ;ScreenMan edit for entry IEN.
N CLASS,DA,DDSCHANG,DDSFILE,DDSPARM,DIDEL,DIMSG,DR,DTOUT,NATOK
S (DDSFILE,DIDEL)=811.2,DDSPARM="CS",DR="["_FORM_"]"
S CLASS=$P(^PXD(811.2,IEN,100),U,1)
S NATOK=$S(CLASS'="N":1,1:($G(PXRMINST)=1)&($G(DUZ(0))="@"))
I 'NATOK D Q
. W !,"National taxonomies cannot be edited."
. H 2
. S VALMBCK="R"
;These ^TMP entries are used by the Lexicon display to store the
;results of the search and selection. Initializing them here minimizes
;the number of Lexicon searches.
K ^TMP("PXRMCODES",$J),^TMP("PXRMLEXS",$J),^TMP("PXRMTEXT",$J)
S DA=IEN
D ^DDS
K ^TMP("PXRMCODES",$J),^TMP("PXRMLEXS",$J),^TMP("PXRMTEXT",$J)
I $D(DIMSG) H 2
;If the entry is new and the user did not save, delete it.
I $G(NEW),$G(DDSSAVE)'=1 D DELETE^PXRMEXFI(811.2,IEN) Q
;If changes were made update the change log and rebuild the
;List Manager list.
I 'NEW,$G(DDSCHANG)'=1 S VALMBCK="R" Q
D BLDLIST^PXRMTAXL("PXRMTAXL")
S VALMBCK="R"
;If the change was a deletion skip the change log.
I '$D(^PXD(811.2,IEN)) Q
N IENS,FDA,FDAIEN,MSG,WPTMP
S IENS="+1,"_IEN_","
S FDA(811.21,IENS,.01)=$$NOW^XLFDT
S FDA(811.21,IENS,1)=DUZ
I NEW D
. S WPTMP(1,1,1)=" Creation."
. S FDA(811.21,IENS,2)="WPTMP(1,1)"
D UPDATE^DIE("S","FDA","FDAIEN","MSG")
K DA,DDSFILE
S DA=FDAIEN(1),DA(1)=IEN
S DDSFILE=811.2,DDSFILE(1)=811.21
S DR="[PXRM TAXONOMY CHANGE LOG]"
D ^DDS
Q
;
PXRMTXSM ;SLC/PKR - Reminder Taxonomy ScreenMan routines ;02-Nov-2015 08:55;du
+1 ;;2.0;CLINICAL REMINDERS;**26,1005**;Feb 04, 2005;Build 23
+2 ;
+3 ;===================================
CODELIST(TAXIEN,TERM,CODESYS) ;See if the temporary list of selected codes
+1 ;exists, if it does not and codes have been stored in the taxonomy
+2 ;then build it.
+3 IF $DATA(^TMP("PXRMCODES",$JOB,TERM,CODESYS))
QUIT
+4 IF '$DATA(^PXD(811.2,TAXIEN,20,"ATC",TERM,CODESYS))
QUIT
+5 MERGE ^TMP("PXRMCODES",$JOB,TERM,CODESYS)=^PXD(811.2,TAXIEN,20,"ATCC",TERM,CODESYS)
+6 QUIT
+7 ;
+8 ;===================================
EXETCCAP(DA) ;Executable caption for code search.
+1 NEW TC
+2 SET TC=$$GET^DDSVAL(811.23,.DA,.01,"","E")
+3 IF $LENGTH(TC)>57
SET TC=$EXTRACT(TC,1,54)_"..."
+4 QUIT " Term/Code: "_TC_" "
+5 ;
+6 ;===================================
LEXSRCH(DA,CODESYS) ;Branch for Lexicon Term/Code search.
+1 ;selection.
+2 NEW PXRMLEXV,SAVEDDS,TAXIEN,TERM
+3 ;These PXRM variables are used in the List Manager Lexicon search.
+4 NEW PXRMBGS,PXRMLEXV
+5 KILL ^TMP("PXRMLEXTC",$JOB)
+6 SET ^TMP("PXRMLEXTC",$JOB,"CODESYS")=CODESYS
+7 SET (^TMP("PXRMLEXTC",$JOB,"LEX TERM"),TERM)=$$GET^DDSVAL(811.23,.DA,.01,"","E")
+8 SET (^TMP("PXRMLEXTC",$JOB,"TAX IEN"),TAXIEN)=DA(1)
+9 DO CODELIST(TAXIEN,TERM,CODESYS)
+10 ;DBIA #5746 covers kill and set of DDS.
+11 IF $DATA(DDS)
SET SAVEDDS=DDS
KILL DDS
+12 DO EN^VALM("PXRM LEXICON SELECT")
+13 KILL ^TMP("PXRMLEXTC",$JOB)
+14 ;Reset the screen so ScreenMan displays properly.
+15 IF $DATA(SAVEDDS)
Begin DoDot:1
+16 NEW IOAWM0,X
+17 SET DDS=SAVEDDS
+18 SET X=0
XECUTE ^%ZOSF("RM")
XECUTE ^%ZOSF("TYPE-AHEAD")
+19 SET X="IOAWM0"
DO ENDR^%ZISS
WRITE IOAWM0
+20 DO REFRESH^DDSUTL
End DoDot:1
+21 QUIT
+22 ;
+23 ;===================================
LTCPAOC(DA) ;Lexicon Term/Code post-action on change.
+1 NEW NTC,OTC,TEXT
+2 SET NTC=$$GET^DDSVAL(811.23,.DA,"TERM/CODE")
+3 SET OTC=$GET(^PXD(811.2,DA(1),20,DA,0))
+4 IF ($LENGTH(OTC)>0)
IF (NTC'=OTC)
Begin DoDot:1
+5 SET TEXT(1)="Overwriting a search Term/Code is not allowed!"
+6 SET TEXT(2)="To replace a search term delete the existing one first."
+7 SET TEXT(3)="$$EOP"
+8 DO HLP^DDSUTL(.TEXT)
+9 DO PUT^DDSVAL(811.23,.DA,"TERM/CODE",OTC)
End DoDot:1
+10 QUIT
+11 ;
+12 ;===================================
NUMCODES(DA) ;Executable caption to display the number of selected codes
+1 ;for Lexicon Term/Code.
+2 ;^TMP("PXRMCODES",$J) will have the value from the current editing
+3 ;session so check it first.
+4 IF DA=""
QUIT $$REPEAT^XLFSTR(" ",30)
+5 NEW CODESYS,COUNT,IND,NUID,NUM,TEMP,TERM,TEXT,UID
+6 SET TERM=$$GET^DDSVAL(811.23,.DA,.01,"","E")
+7 SET CODESYS=""
+8 FOR
SET CODESYS=$ORDER(^TMP("PXRMCODES",$JOB,TERM,CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:1
+9 SET CODE=""
SET (NUID,NUM)=0
+10 FOR
SET CODE=$ORDER(^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:2
+11 SET NUM=NUM+1
+12 SET UID=^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE)
+13 IF UID=1
SET NUID=NUID+1
End DoDot:2
+14 SET COUNT(CODESYS)=NUM
+15 SET NUID(CODESYS)=NUID
End DoDot:1
+16 ;Check for stored values.
+17 SET IND=0
+18 FOR
SET IND=+$ORDER(^PXD(811.2,DA(1),20,DA,1,IND))
IF IND=0
QUIT
Begin DoDot:1
+19 SET TEMP=^PXD(811.2,DA(1),20,DA,1,IND,0)
+20 SET CODESYS=$PIECE(TEMP,U,1)
SET NUM=$PIECE(TEMP,U,2)
SET NUID=$PIECE(TEMP,U,3)
+21 IF $DATA(COUNT(CODESYS))!(NUM=0)
QUIT
+22 SET COUNT(CODESYS)=NUM
+23 SET NUID(CODESYS)=NUID
End DoDot:1
+24 IF '$DATA(COUNT)
QUIT "None"_$$REPEAT^XLFSTR(" ",26)
+25 SET (CODESYS,TEXT)=""
+26 FOR
SET CODESYS=$ORDER(COUNT(CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:1
+27 SET TEXT=TEXT_CODESYS_":"_COUNT(CODESYS)
+28 IF NUID(CODESYS)>0
SET TEXT=TEXT_":"_NUID(CODESYS)
+29 SET TEXT=TEXT_" "
End DoDot:1
+30 SET NUM=$LENGTH(TEXT)
+31 IF NUM<30
SET TEXT=TEXT_$$REPEAT^XLFSTR(" ",(30-NUM))
+32 QUIT TEXT
+33 ;
+34 ;===================================
POSTACT(D0) ;Form Post Action
+1 NEW INACTIVE,INUSE,OUTPUT
+2 KILL ^TMP("PXRMCODES",$JOB)
+3 ;If the change was a deletion there is nothing else to do.
+4 IF '$DATA(^PXD(811.2,D0))
QUIT
+5 ;If the taxonomy was inactivated check to see if it is being used.
+6 SET INACTIVE=$$GET^DDSVAL(811.2,D0,"INACTIVE FLAG")
+7 SET INUSE=$SELECT(INACTIVE:$$INUSE^PXRMTAXD(D0,"INACT"),1:0)
+8 IF INUSE
DO HLP^DDSUTL("$$EOP")
+9 ;Check for dialog problems.
+10 DO TAXEDITC^PXRMDTAX(D0,.OUTPUT)
+11 IF $DATA(OUTPUT)
Begin DoDot:1
+12 ;IHS/MSC/MGH Newed Variables
+13 NEW IOSTBM,IORI
+14 DO BROWSE^DDBR("OUTPUT","NR","Problems with dialogs using this taxonomy.")
+15 IF $DATA(DDS)
DO REFRESH^DDSUTL
SET DY=IOSL-7
SET DX=0
XECUTE IOXY
SET $Y=DY
SET $X=DX
End DoDot:1
+16 QUIT
+17 ;
+18 ;===================================
POSTSAVE(IEN) ;Form Post Save. Store changes in lists of codes.
+1 NEW CODE,CODESYS,CSYIND,FDA,KCSYSIND,KFDA,MSG,NSEL,NUID,PDS
+2 NEW TEMP,TERM,TERMIND,TEXT,UID
+3 SET TERM=""
SET TERMIND=0
+4 FOR
SET TERM=$ORDER(^TMP("PXRMCODES",$JOB,TERM))
IF TERM=""
QUIT
Begin DoDot:1
+5 ;If this term has been deleted, skip the rest.
+6 IF '$DATA(^PXD(811.2,IEN,20,"B",TERM))
QUIT
+7 SET TERMIND=$ORDER(^PXD(811.2,IEN,20,"B",TERM,""))
+8 SET CODESYS=""
SET CSYSIND=TERMIND
+9 FOR
SET CODESYS=$ORDER(^TMP("PXRMCODES",$JOB,TERM,CODESYS))
IF CODESYS=""
QUIT
Begin DoDot:2
+10 ;Check for existing entries for this term and this coding system.
+11 ;If there are any remove them before storing the new set.
+12 IF $DATA(^PXD(811.2,IEN,20,"ATC",TERM,CODESYS))
Begin DoDot:3
+13 SET KCSYSIND=$PIECE(^PXD(811.2,IEN,20,"ATC",TERM,CODESYS),U,2)
+14 SET IENS=KCSYSIND_","_TERMIND_","_IEN_","
+15 SET KFDA(811.231,IENS,.01)="@"
+16 DO FILE^DIE("","KFDA","MSG")
End DoDot:3
+17 SET CSYSIND=CSYSIND+1
+18 SET (NSEL,NUID)=0
SET CODE=""
+19 FOR
SET CODE=$ORDER(^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE))
IF CODE=""
QUIT
Begin DoDot:3
+20 SET NSEL=NSEL+1
+21 SET UID=^TMP("PXRMCODES",$JOB,TERM,CODESYS,CODE)
+22 IF UID=1
SET NUID=NUID+1
+23 SET IENS="+"_(NSEL+CSYSIND)_",+"_CSYSIND_","_TERMIND_","_IEN_","
+24 SET FDA(811.2312,IENS,.01)=CODE
+25 SET FDA(811.2312,IENS,1)=UID
End DoDot:3
+26 SET IENS="+"_CSYSIND_","_TERMIND_","_IEN_","
+27 SET FDA(811.231,IENS,.01)=CODESYS
+28 SET FDA(811.231,IENS,1)=NSEL
+29 SET FDA(811.231,IENS,3)=NUID
+30 SET CSYSIND=NSEL+CSYSIND
End DoDot:2
+31 DO UPDATE^DIE("","FDA","","MSG")
+32 IF $DATA(MSG)
Begin DoDot:2
+33 SET TEXT(1)="Error storing codes for term "_TERM
+34 SET TEXT(2)=" coding system "_CODESYS
+35 DO EN^DDIOL(.TEXT)
+36 DO AWRITE^PXRMUTIL("MSG")
+37 HANG 2
End DoDot:2
End DoDot:1
+38 KILL ^TMP("PXRMCODES",$JOB)
+39 ;Make sure Patient Data Source index is built.
+40 SET PDS=$$GET^DDSVAL(811.2,IEN,"PATIENT DATA SOURCE")
+41 IF PDS=""
DO SPDS^PXRMPDS(IEN,PDS)
+42 QUIT
+43 ;
+44 ;===================================
SMANEDIT(IEN,NEW,FORM) ;ScreenMan edit for entry IEN.
+1 NEW CLASS,DA,DDSCHANG,DDSFILE,DDSPARM,DIDEL,DIMSG,DR,DTOUT,NATOK
+2 SET (DDSFILE,DIDEL)=811.2
SET DDSPARM="CS"
SET DR="["_FORM_"]"
+3 SET CLASS=$PIECE(^PXD(811.2,IEN,100),U,1)
+4 SET NATOK=$SELECT(CLASS'="N":1,1:($GET(PXRMINST)=1)&($GET(DUZ(0))="@"))
+5 IF 'NATOK
Begin DoDot:1
+6 WRITE !,"National taxonomies cannot be edited."
+7 HANG 2
+8 SET VALMBCK="R"
End DoDot:1
QUIT
+9 ;These ^TMP entries are used by the Lexicon display to store the
+10 ;results of the search and selection. Initializing them here minimizes
+11 ;the number of Lexicon searches.
+12 KILL ^TMP("PXRMCODES",$JOB),^TMP("PXRMLEXS",$JOB),^TMP("PXRMTEXT",$JOB)
+13 SET DA=IEN
+14 DO ^DDS
+15 KILL ^TMP("PXRMCODES",$JOB),^TMP("PXRMLEXS",$JOB),^TMP("PXRMTEXT",$JOB)
+16 IF $DATA(DIMSG)
HANG 2
+17 ;If the entry is new and the user did not save, delete it.
+18 IF $GET(NEW)
IF $GET(DDSSAVE)'=1
DO DELETE^PXRMEXFI(811.2,IEN)
QUIT
+19 ;If changes were made update the change log and rebuild the
+20 ;List Manager list.
+21 IF 'NEW
IF $GET(DDSCHANG)'=1
SET VALMBCK="R"
QUIT
+22 DO BLDLIST^PXRMTAXL("PXRMTAXL")
+23 SET VALMBCK="R"
+24 ;If the change was a deletion skip the change log.
+25 IF '$DATA(^PXD(811.2,IEN))
QUIT
+26 NEW IENS,FDA,FDAIEN,MSG,WPTMP
+27 SET IENS="+1,"_IEN_","
+28 SET FDA(811.21,IENS,.01)=$$NOW^XLFDT
+29 SET FDA(811.21,IENS,1)=DUZ
+30 IF NEW
Begin DoDot:1
+31 SET WPTMP(1,1,1)=" Creation."
+32 SET FDA(811.21,IENS,2)="WPTMP(1,1)"
End DoDot:1
+33 DO UPDATE^DIE("S","FDA","FDAIEN","MSG")
+34 KILL DA,DDSFILE
+35 SET DA=FDAIEN(1)
SET DA(1)=IEN
+36 SET DDSFILE=811.2
SET DDSFILE(1)=811.21
+37 SET DR="[PXRM TAXONOMY CHANGE LOG]"
+38 DO ^DDS
+39 QUIT
+40 ;
