Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMUTIL

PXRMUTIL.m

Go to the documentation of this file.
  1. PXRMUTIL ;SLC/PKR/PJH - Utility routines for use by PXRM. ;02/25/2021
  1. ;;2.0;CLINICAL REMINDERS;**4,6,11,12,17,18,24,26,47,42**;Feb 04, 2005;Build 245
  1. ;
  1. ;=================================
  1. ACOPY(REF,OUTPUT) ;Copy all the descendants of the array reference into a linear
  1. ;array. REF is the starting array reference, for example A or
  1. ;^TMP("PXRM",$J). OUTPUT is the linear array for the output. It
  1. ;should be in the form of a closed root, i.e., A() or ^TMP($J,).
  1. ;Note OUTPUT cannot be used as the name of the output array.
  1. N DONE,IND,LEN,NL,OROOT,OUT,PROOT,ROOT,START,TEMP
  1. I REF="" Q
  1. S NL=0
  1. S OROOT=$P(OUTPUT,")",1)
  1. S PROOT=$P(REF,")",1)
  1. ;Build the root so we can tell when we are done.
  1. S TEMP=$NA(@REF)
  1. S ROOT=$P(TEMP,")",1)
  1. S REF=$Q(@REF)
  1. I REF'[ROOT Q
  1. S DONE=0
  1. F Q:(REF="")!(DONE) D
  1. . S START=$F(REF,ROOT)
  1. . S LEN=$L(REF)
  1. . S IND=$E(REF,START,LEN)
  1. . S NL=NL+1
  1. . S OUT=OROOT_NL_")"
  1. . S @OUT=PROOT_IND_"="_@REF
  1. . S REF=$Q(@REF)
  1. . I REF'[ROOT S DONE=1
  1. Q
  1. ;
  1. ;=================================
  1. APRINT(REF) ;Write all the descendants of the array reference.
  1. ;REF is the starting array reference, for example A or
  1. ;^TMP("PXRM",$J).
  1. N APTEXT,DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP
  1. I REF="" Q
  1. S LN=0
  1. S PROOT=$P(REF,")",1)
  1. ;Build the root so we can tell when we are done.
  1. S TEMP=$NA(@REF)
  1. S ROOT=$P(TEMP,")",1)
  1. S REF=$Q(@REF)
  1. I REF'[ROOT Q
  1. S DONE=0
  1. F Q:(REF="")!(DONE) D
  1. . S START=$F(REF,ROOT)
  1. . S LEN=$L(REF)
  1. . S IND=$E(REF,START,LEN)
  1. . S LN=LN+1,APTEXT(LN)=@REF
  1. . S REF=$Q(@REF)
  1. . I REF'[ROOT S DONE=1
  1. I $D(XPDNM) D MES^XPDUTL(.APTEXT)
  1. E D EN^DDIOL(.APTEXT)
  1. Q
  1. ;
  1. ;=================================
  1. ATTVALUE(STRING,ATTR,SEP,AVSEP) ;STRING contains a list of attribute value
  1. ;pairs. Each pair is separated by SEP and the attribute value pair
  1. ;is separated by AVSEP. Return the value for the attribute ATTR.
  1. N AVPAIR,IND,NUMAVP,VALUE
  1. S NUMAVP=$L(STRING,SEP)
  1. S VALUE=""
  1. F IND=1:1:NUMAVP Q:VALUE'="" D
  1. . S AVPAIR=$P(STRING,SEP,IND)
  1. . I AVPAIR[ATTR S VALUE=$P(AVPAIR,AVSEP,2)
  1. Q VALUE
  1. ;
  1. ;=================================
  1. AWRITE(REF) ;Write all the descendants of the array reference, including the
  1. ;array. REF is the starting array reference, for example A or
  1. ;^TMP("PXRM",$J).
  1. N AWTEXT,DONE,IND,LEN,LN,PROOT,ROOT,START,TEMP
  1. I REF="" Q
  1. S LN=0
  1. S PROOT=$P(REF,")",1)
  1. ;Build the root so we can tell when we are done.
  1. S TEMP=$NA(@REF)
  1. S ROOT=$P(TEMP,")",1)
  1. S REF=$Q(@REF)
  1. I REF'[ROOT Q
  1. S DONE=0
  1. F Q:(REF="")!(DONE) D
  1. . S START=$F(REF,ROOT)
  1. . S LEN=$L(REF)
  1. . S IND=$E(REF,START,LEN)
  1. . S LN=LN+1,AWTEXT(LN)=PROOT_IND_"="_@REF
  1. . S REF=$Q(@REF)
  1. . I REF'[ROOT S DONE=1
  1. I $D(XPDNM) D MES^XPDUTL(.AWTEXT)
  1. E D EN^DDIOL(.AWTEXT)
  1. Q
  1. ;
  1. ;=================================
  1. BORP(DEFAULT) ;Ask the user if they want to browse or print.
  1. N DIR,POP,X,Y
  1. S DIR(0)="SA"_U_"B:Browse;P:Print"
  1. S DIR("A")="Browse or Print? "
  1. S DIR("B")=DEFAULT
  1. D ^DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q ""
  1. Q Y
  1. ;
  1. ;=================================
  1. DEFURLAD(DEF,NEWURL) ;Add a new URL to a reminder definition.
  1. N FDA,IEN,IENS,MSG,WPTMP
  1. S IEN=+$O(^PXD(811.9,"B",DEF,""))
  1. I IEN=0 Q
  1. I $D(^PXD(811.9,IEN,50,"B",NEWURL)) Q
  1. S IENS="+1,"_IEN_","
  1. S FDA(811.9002,IENS,.01)=NEWURL
  1. I $D(NEWURL("TITLE")) S FDA(811.9002,IENS,.02)=NEWURL("TITLE")
  1. I $D(NEWURL("DESC")) D
  1. . M WPTMP=NEWURL("DESC")
  1. . S FDA(811.9002,IENS,1)="WPTMP"
  1. D UPDATE^DIE("","FDA","","MSG")
  1. Q
  1. ;
  1. ;=================================
  1. DEFURLUP(DEF,OLDURL,NEWURL) ;Update a URL in a reminder definition.
  1. N FDA,IEN,IENS,IND,MSG,WPTMP
  1. S IEN=+$O(^PXD(811.9,"B",DEF,""))
  1. I IEN=0 Q
  1. S IND=+$O(^PXD(811.9,IEN,50,"B",OLDURL,""))
  1. I IND=0 Q
  1. S IENS=IND_","_IEN_","
  1. S FDA(811.9002,IENS,.01)=NEWURL
  1. I $D(NEWURL("TITLE")) S FDA(811.9002,IENS,.02)=NEWURL("TITLE")
  1. I $D(NEWURL("DESC")) D
  1. . M WPTMP=NEWURL("DESC")
  1. . S FDA(811.9002,IENS,1)="WPTMP"
  1. D FILE^DIE("","FDA","MSG")
  1. Q
  1. ;
  1. ;=================================
  1. DELTLFE(FILENUM,NAME) ;Delete top level entries from a file.
  1. N FDA,IENS,MSG
  1. S IENS=+$$FIND1^DIC(FILENUM,"","BXU",NAME)
  1. I IENS=0 Q
  1. S IENS=IENS_","
  1. S FDA(FILENUM,IENS,.01)="@"
  1. D FILE^DIE("","FDA","MSG")
  1. Q
  1. ;
  1. ;=================================
  1. DIP(VAR,IEN,PXRMROOT,FLDS) ;Do general inquiry for IEN return formatted
  1. ;output in VAR. VAR can be either a local variable or a global.
  1. ;If it is a local it is indexed for the broker. If it is a global
  1. ;it should be passed in closed form i.e., ^TMP("PXRMTEST",$J).
  1. ;It will be returned formatted for List Manager i.e.,
  1. ;^TMP("PXRMTEST",$J,N,0).
  1. N %ZIS,ARRAY,BY,DC,DHD,DIC,DONE,FF,FILENAME,FILESPEC,FR,GBL,HFNAME
  1. N IND,IOP,L,NOW,PATH,SUCCESS,TO,UNIQN
  1. S BY="NUMBER",(FR,TO)=+$P(IEN,U,1),DHD="@@"
  1. ;Make sure the PXRM WORKSTATION device exists.
  1. D MKWSDEV^PXRMHOST
  1. ;Set up the output file before DIP is called.
  1. S PATH=$$PWD^%ZISH
  1. S NOW=$$NOW^XLFDT
  1. S NOW=$TR(NOW,".","")
  1. S UNIQN=$J_NOW
  1. S FILENAME="PXRMWSD"_UNIQN_".DAT"
  1. S HFNAME=PATH_FILENAME
  1. S IOP="PXRM WORKSTATION;80"
  1. S %ZIS("HFSMODE")="W"
  1. S %ZIS("HFSNAME")=HFNAME
  1. S L=0,DIC=PXRMROOT
  1. D EN1^DIP
  1. ;Move the host file into a global.
  1. S GBL="^TMP(""PXRMUTIL"",$J,1,0)"
  1. S GBL=$NA(@GBL)
  1. K ^TMP("PXRMUTIL",$J)
  1. S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)
  1. ;Look for a form feed, remove it and all subsequent lines.
  1. S FF=$C(12)
  1. I $G(VAR)["^" D
  1. . S VAR=$NA(@VAR)
  1. . S VAR=$P(VAR,")",1)
  1. . S VAR=VAR_",IND,0)"
  1. . S (DONE,IND)=0
  1. . F Q:DONE S IND=$O(^TMP("PXRMUTIL",$J,IND)) Q:+IND=0 D
  1. .. I ^TMP("PXRMUTIL",$J,IND,0)=FF S DONE=1 Q
  1. .. S @VAR=^TMP("PXRMUTIL",$J,IND,0)
  1. E D
  1. . S (DONE,IND)=0
  1. . F Q:DONE S IND=$O(^TMP("PXRMUTIL",$J,IND)) Q:+IND=0 D
  1. .. S VAR(IND)=^TMP("PXRMUTIL",$J,IND,0)
  1. .. I VAR(IND)=FF K ARRAY(IND) S DONE=1
  1. K ^TMP("PXRMUTIL",$J)
  1. ;Delete the host file.
  1. S FILESPEC(FILENAME)=""
  1. S SUCCESS=$$DEL^%ZISH(PATH,$NA(FILESPEC))
  1. Q
  1. ;
  1. ;=================================
  1. FNFR(ROOT) ;Given the root of a file return the file number.
  1. Q +$P(@(ROOT_"0)"),U,2)
  1. ;
  1. ;=================================
  1. GPRINT(REF) ;General printing.
  1. N DIR,POP,SAVEIOT
  1. S %ZIS="Q"
  1. D ^%ZIS
  1. I POP Q
  1. I $D(IO("Q")) D Q
  1. . N ZTDESC,ZTRTN,ZTSAVE
  1. . S ZTSAVE("IO")=""
  1. .;Save the evaluated name of REF.
  1. . S ZTSAVE("REF")=$NA(@$$CREF^DILF(REF))
  1. .;Save the open root form for TaskMan.
  1. . S ZTSAVE($$OREF^DILF(ZTSAVE("REF")))=""
  1. . S ZTRTN="GPRINTQ^PXRMUTIL"
  1. . S ZTDESC="Queued print job"
  1. . D ^%ZTLOAD
  1. . W !,"Task number ",ZTSK
  1. . D HOME^%ZIS
  1. . K IO("Q")
  1. . H 2
  1. ;If this is being called from List Manager go to full screen.
  1. I $D(VALMDDF) D FULL^VALM1
  1. U IO
  1. D APRINT^PXRMUTIL(REF)
  1. ;Save IOT before it is reset.
  1. S SAVEIOT=IOT
  1. D ^%ZISC
  1. I SAVEIOT["TRM" S DIR(0)="E",DIR("A")="Press ENTER to continue" D ^DIR
  1. I $D(VALMDDF) S VALMBCK="R"
  1. Q
  1. ;
  1. ;=================================
  1. GPRINTQ ;Queued general printing.
  1. U IO
  1. D APRINT^PXRMUTIL(REF)
  1. D ^%ZISC
  1. S ZTREQ="@"
  1. Q
  1. ;
  1. ;=================================
  1. NTOAN(NUMBER) ;Given an integer N return an alphabetic string that can be
  1. ;used for sorting. This will be modulus 26. For example N=0 returns
  1. ;A, N=26 returns BA etc.
  1. N ALPH
  1. S ALPH(0)="A",ALPH(1)="B",ALPH(2)="C",ALPH(3)="D",ALPH(4)="E"
  1. S ALPH(5)="F",ALPH(6)="G",ALPH(7)="H",ALPH(8)="I",ALPH(9)="J"
  1. S ALPH(10)="K",ALPH(11)="L",ALPH(12)="M",ALPH(13)="N",ALPH(14)="O"
  1. S ALPH(15)="P",ALPH(16)="Q",ALPH(17)="R",ALPH(18)="S",ALPH(19)="T"
  1. S ALPH(20)="U",ALPH(21)="V",ALPH(22)="W",ALPH(23)="X",ALPH(24)="Y"
  1. S ALPH(25)="Z"
  1. ;
  1. N ANUM,DIGIT,NUM,P26,PC,PWR
  1. S ANUM="",NUM=NUMBER,PWR=0
  1. S P26(PWR)=1
  1. F PWR=1:1 S P26(PWR)=26*P26(PWR-1) I P26(PWR)>NUMBER Q
  1. S PWR=PWR-1
  1. F PC=PWR:-1:0 D
  1. . S DIGIT=NUM\P26(PC)
  1. . S ANUM=ANUM_ALPH(DIGIT)
  1. . S NUM=NUM-(DIGIT*P26(PC))
  1. Q ANUM
  1. ;
  1. ;=================================
  1. OPTION(OPTLU,ACTION,OOM,OOMTEXT) ;Out of order loop over options in list.
  1. N EXISTOOM,IEN,IND,LIST,OPT
  1. D FIND^DIC(19,"","@;.01","",OPTLU,"*","B","","","LIST")
  1. F IND=1:1:+LIST("DILIST",0) D
  1. . S IEN=LIST("DILIST",2,IND)
  1. . S EXISTOOM=$$GET1^DIQ(19,IEN,2)
  1. . I (ACTION="DISABLE"),(EXISTOOM'="") Q
  1. . I (ACTION="ENABLE"),(EXISTOOM'=OOMTEXT) Q
  1. . S OPT=LIST("DILIST","ID",IND,.01)
  1. . D OUT^XPDMENU(OPT,OOM)
  1. Q
  1. ;
  1. ;=================================
  1. OPTIONS(ACTION,OOMTEXT) ;Disable/enable options.
  1. N OOM
  1. S OOM=$S(ACTION="DISABLE":OOMTEXT,ACTION="ENABLE":"",1:"")
  1. D BMES^XPDUTL(ACTION_" options.")
  1. D OPTION^PXRMUTIL("GMTS",ACTION,OOM,OOMTEXT)
  1. D OPTION^PXRMUTIL("IBDF PRINT",ACTION,OOM,OOMTEXT)
  1. D OPTION^PXRMUTIL("OR CPRS GUI CHART",ACTION,OOM,OOMTEXT)
  1. D OPTION^PXRMUTIL("ORS HEALTH SUMMARY",ACTION,OOM,OOMTEXT)
  1. D OPTION^PXRMUTIL("PXRM",ACTION,OOM,OOMTEXT)
  1. Q
  1. ;
  1. ;=================================
  1. PROTOCOL(PROTLU,ACTION,DISABLE,DISTEXT) ;Disable/enable protocols.
  1. N EXISTDIS,FDA,IEN,IENS,MSG
  1. S IEN=+$$FIND1^DIC(101,"","X",PROTLU,"B")
  1. I IEN=0 Q
  1. S EXISTDIS=$$GET1^DIQ(101,IEN,2)
  1. I (ACTION="DISABLE"),(EXISTDIS'="") Q
  1. I (ACTION="ENABLE"),(EXISTDIS'=DISTEXT) Q
  1. S IENS=IEN_","
  1. S FDA(101,IENS,2)=DISABLE
  1. D FILE^DIE("","FDA","MSG")
  1. Q
  1. ;
  1. ;=================================
  1. PROTCOLS(ACTION,DISTEXT) ;Disable/enable protocols.
  1. N DISABLE,PROT,RESULT
  1. S DISABLE=$S(ACTION="DISABLE":DISTEXT,ACTION="ENABLE":"",1:"")
  1. D BMES^XPDUTL(ACTION_" protocols.")
  1. ;
  1. D PROTOCOL^PXRMUTIL("ORS HEALTH SUMMARY",ACTION,DISABLE,DISTEXT)
  1. D PROTOCOL^PXRMUTIL("ORS AD HOC HEALTH SUMMARY",ACTION,DISABLE,DISTEXT)
  1. D PROTOCOL^PXRMUTIL("PXRM PATIENT DATA CHANGE",ACTION,DISABLE,DISTEXT)
  1. Q
  1. ;
  1. ;=================================
  1. RENAME(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
  1. ;file number FILENUM.
  1. N IEN,NIEN,MSG,PXRMINST
  1. S IEN=+$$FIND1^DIC(FILENUM,"","BXU",OLDNAME)
  1. I IEN=0 Q
  1. S PXRMINST=1
  1. S NIEN=+$$FIND1^DIC(FILENUM,"","BXU",NEWNAME) I NIEN>0 Q
  1. S FDA(FILENUM,IEN_",",.01)=NEWNAME
  1. D FILE^DIE("ET","FDA","MSG")
  1. Q
  1. ;
  1. ;=================================
  1. RMEHIST(FILENUM,IEN) ;Remove the edit history for a reminder file.
  1. I (FILENUM<800)!(FILENUM>811.9)!(FILENUM=811.8) Q
  1. N DA,DIK,GLOBAL,ROOT
  1. S GLOBAL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
  1. ;Edit History is stored in node 110 for all files.
  1. S DA(1)=IEN
  1. S DIK=GLOBAL_IEN_",110,"
  1. S ROOT=GLOBAL_IEN_",110,DA)"
  1. S DA=0
  1. F S DA=+$O(@ROOT) Q:DA=0 D ^DIK
  1. Q
  1. ;
  1. ;=================================
  1. SEHIST(FILENUM,ROOT,IEN) ;Set the edit date and edit by and prompt the
  1. ;user for the edit comment.
  1. N DIC,DIR,DWLW,DWPK,ENTRY,FDA,FDAIEN,IENS,IND,MSG,SFN,TARGET,X,Y
  1. K ^TMP("PXRMWP",$J)
  1. D FIELD^DID(FILENUM,"EDIT HISTORY","","SPECIFIER","TARGET")
  1. S SFN=+$G(TARGET("SPECIFIER"))
  1. I SFN=0 Q
  1. S ENTRY=ROOT_IEN_",110)"
  1. S IND=$O(@ENTRY@("B"),-1)
  1. S IND=IND+1
  1. S IENS="+"_IND_","_IEN_","
  1. S FDAIEN(IEN)=IEN
  1. S FDA(SFN,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1. S FDA(SFN,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
  1. ;Prompt the user for edit comments.
  1. S DIC="^TMP(""PXRMWP"",$J,"
  1. S DWLW=72
  1. S DWPK=1
  1. W !,"Input your edit comments."
  1. S DIR(0)="Y"_U_"AO"
  1. S DIR("A")="Edit"
  1. S DIR("B")="NO"
  1. D ^DIR
  1. I Y D
  1. . D EN^DIWE
  1. . K ^TMP("PXRMWP",$J,0)
  1. . I $D(^TMP("PXRMWP",$J)) S FDA(SFN,IENS,2)="^TMP(""PXRMWP"",$J)"
  1. D UPDATE^DIE("E","FDA","FDAIEN","MSG")
  1. I $D(MSG) D AWRITE^PXRMUTIL("MSG")
  1. K ^TMP("PXRMWP",$J)
  1. Q
  1. ;
  1. ;=================================
  1. SETPVER(VERSION) ;Set the package version
  1. N DA,DIE,DR
  1. S DIE="^PXRM(800,",DA=1,DR="5////"_VERSION
  1. D ^DIE
  1. Q
  1. ;
  1. ;=================================
  1. SFRES(SDIR,NRES,FIEVAL) ;Save the finding result.
  1. I NRES=0 S FIEVAL=0 Q
  1. N DATE,IND,OA,SUB,TF
  1. F IND=1:1:NRES S OA(FIEVAL(IND,"DATE"),FIEVAL(IND),IND)=""
  1. ;If SDIR is positive get the oldest date otherwise get the most
  1. ;recent date.
  1. S DATE=$S(SDIR>0:$O(OA("")),1:$O(OA(""),-1))
  1. ;If there is a true finding on DATE get it.
  1. S TF=$O(OA(DATE,""),-1)
  1. S IND=$O(OA(DATE,TF,""))
  1. S FIEVAL=TF
  1. S SUB=""
  1. F S SUB=$O(FIEVAL(IND,SUB)) Q:SUB="" M FIEVAL(SUB)=FIEVAL(IND,SUB)
  1. Q
  1. ;
  1. ;=================================
  1. SSPAR(FIND0,NOCC,BDT,EDT) ;Set the finding search parameters.
  1. S BDT=$P(FIND0,U,8),EDT=$P(FIND0,U,11),NOCC=$P(FIND0,U,14)
  1. I +NOCC=0 S NOCC=1
  1. ;Convert the dates to FileMan dates.
  1. S BDT=$S(BDT="":0,BDT=0:0,1:$$CTFMD^PXRMDATE(BDT))
  1. I EDT="" S EDT="T"
  1. I $G(PXRMDEBG)=1 D
  1. . N TIME S TIME=$P(PXRMDATE,".",2)
  1. . I TIME'="" S TIME="."_TIME
  1. . S EDT=$S(EDT="T":PXRMDATE,1:$$CTFMD^PXRMDATE(EDT)_TIME)
  1. E S EDT=$$CTFMD^PXRMDATE(EDT)
  1. ;If EDT does not contain a time set it to the end of the day.
  1. I (EDT'=-1),EDT'["." S EDT=EDT_".235959"
  1. I $G(PXRMDDOC)'=1 Q
  1. S ^TMP("PXRMDDOC",$J,$P(FIND0,U,1,11))=BDT_U_EDT
  1. Q
  1. ;
  1. ;=================================
  1. STRREP(STRING,TS,RS) ;Replace every occurrence of the target string (TS)
  1. ;in STRING with the replacement string (RS).
  1. ;Example 9.19 (page 220) in "The Complete Mumps" by John Lewkowicz:
  1. ; F Q:STRING'[TS S STRING=$P(STRING,TS)_RS_$P(STRING,TS,2,999)
  1. ;fails if any portion of the target string is contained in the with
  1. ;string. Therefore a more elaborate version is required.
  1. ;
  1. N IND,NPCS,STR
  1. I STRING'[TS Q STRING
  1. ;Count the number of pieces using the target string as the delimiter.
  1. S NPCS=$L(STRING,TS)
  1. ;Extract the pieces and concatenate RS
  1. S STR=""
  1. F IND=1:1:NPCS-1 S STR=STR_$P(STRING,TS,IND)_RS
  1. S STR=STR_$P(STRING,TS,NPCS)
  1. Q STR
  1. ;
  1. ;=================================
  1. UPEHIST(FILENUM,IEN,TEXT,MSG) ;Update the edit history.
  1. N FDA,GBL,IENS,IND,LN,NEXT,SUBFN,TARGET,WPTMP
  1. D FIELD^DID(FILENUM,"EDIT HISTORY","","SPECIFIER","TARGET")
  1. S SUBFN=+$G(TARGET("SPECIFIER"))
  1. I SUBFN=0 Q
  1. S GBL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")_IEN_",110)"
  1. S NEXT=$O(@GBL@("B"),-1)+1
  1. S (IND,LN)=0
  1. F S IND=$O(TEXT(IND)) Q:IND="" D
  1. . S LN=LN+1
  1. . S WPTMP(1,2,LN)=TEXT(IND)
  1. S IENS="+"_NEXT_","_IEN_","
  1. S FDA(SUBFN,IENS,.01)=$$NOW^XLFDT
  1. S FDA(SUBFN,IENS,1)=$G(DUZ)
  1. S FDA(SUBFN,IENS,2)="WPTMP(1,2)"
  1. D UPDATE^DIE("","FDA","","MSG")
  1. Q
  1. ;
  1. ;=================================
  1. VEDIT(ROOT,IEN) ;This is used as a DIC("S") screen to select which entries
  1. ;a user can edit.
  1. N CLASS,ENTRY,VALID
  1. S ENTRY=ROOT_IEN_")"
  1. S CLASS=$P($G(@ENTRY@(100)),U,1)
  1. I CLASS="N" D
  1. . I ($G(PXRMINST)=1),(DUZ(0)="@") S VALID=1
  1. . E S VALID=0
  1. E S VALID=1
  1. Q VALID
  1. ;