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

XTVSLP.m

Go to the documentation of this file.
  1. XTVSLP ;ALBANY FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
  1. ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point for XTVS PKG MGR PARAM DISPLAY
  1. D EN^VALM("XTVS PKG MGR PARAM DISPLAY")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. NEW DEFDIR,SPCPAD,DIRHEAD
  1. SET SPCPAD=""
  1. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. SET VALMHDR(1)=" VistA Package Size Analysis Manager - Parameter Display"
  1. SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
  1. SET DIRHEAD="Default Directory: "_DEFDIR
  1. SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
  1. SET VALMHDR(3)=SPCPAD_DIRHEAD
  1. SET SPCPAD=""
  1. SET DIRHEAD="Parameter file: "_XTVPSPRM
  1. SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
  1. SET VALMHDR(4)=SPCPAD_DIRHEAD
  1. DO MSG
  1. QUIT
  1. ;
  1. BUILD ; - Build local and global display arrays
  1. NEW DEFDIR,LINEITEM
  1. DO KILL ;Kill all processing & data arrays and video attributes & control arrays
  1. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"R")
  1. U IO
  1. SET VALMCNT=0
  1. FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
  1. . IF LINEITEM]"" DO
  1. .. DO SCAPARY(LINEITEM) ;Creates ^TMP("XTVS-PARAM-CAP",$J) array
  1. .. DO SPLITADD^XTVSLAPI(.VALMCNT,LINEITEM,1)
  1. .. DO LOADTMP(LINEITEM) ;Store LineItem into ^TMP global & Index
  1. D CLOSE^%ZISH("XTMP")
  1. QUIT
  1. ;
  1. INIT ; -- init variables and list array
  1. NEW XTVSXFNM
  1. DO FULL^VALM1
  1. IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO
  1. . NEW CHKLKER,LCKCHK,DEFDIR
  1. . SET XTVSXFNM=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM)
  1. . IF XTVSXFNM]"" DO
  1. .. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. .. SET XTVPSPRM=XTVSXFNM
  1. .. SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM) ;Returns 1 when current process has lock
  1. .. SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM) ;Returns 1 when any process has lock
  1. .. IF (+CHKLKER=0)!(+LCKCHK=1) DO
  1. ... DO:(+CHKLKER=0) JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
  1. ... DO:(+LCKCHK=1) JUSTPAWS^XTVSLAPI(XTVPSPRM_" LOCK already held.")
  1. ... DO BUILD
  1. .. IF (+CHKLKER=1),(+LCKCHK'=1) DO
  1. ... W !!," <* LOCK request denied! Try again later. *>"
  1. ... DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
  1. ... DO EXIT^XTVSLP S VALMQUIT=""
  1. . IF XTVSXFNM']"" SET VALMQUIT=""
  1. IF ((+$G(FIRSTITM)'>0)&(+$G(LASTITM)'>0))!($G(XTVSXFNM)']"") SET VALMQUIT=""
  1. QUIT
  1. ;
  1. HELP ; -- help code
  1. IF $D(X),X'["??" DO
  1. . SET X="?"
  1. . DO DISP^XQORM1 W !
  1. IF $D(X),X["??" DO
  1. . DO CLEAR^VALM1
  1. . DO FULL^VALM1
  1. . WRITE !,"Parameter Display action help..."
  1. . WRITE !,"List specific actions:",!
  1. . DO DISP^XQORM1 W !!
  1. . SET XTQVAR=Y
  1. . IF XTQVAR DO
  1. .. SET XTQVAR=0
  1. .. FOR TXTCT=1:1 SET XTX=$P($T(LPTXT+TXTCT^XTVSHLP1),";",3,99) QUIT:XTX="$END" QUIT:XTQVAR DO
  1. ... IF XTX="$PAUSE" DO PAUSE^VALM1 D:Y CLEAR^VALM1 IF 'Y SET XTQVAR=1 QUIT
  1. ... W !,$S(XTX["$PAUSE":"",1:XTX)
  1. . W !
  1. S VALMBCK="R"
  1. D MSG
  1. K XTX,Y,TXTCT,XTQVAR
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. NEW DEFDIR,LCKCHK
  1. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. IF $G(XTVPSPRM)]"" SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
  1. DO FULL^VALM1
  1. IF ($P($G(LCKCHK),"^")=1) DO
  1. . NEW UNLKRSLT
  1. . SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
  1. . IF ($P(UNLKRSLT,"^")'=1) W !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
  1. . DO JUSTPAWS^XTVSLAPI($P(UNLKRSLT,"^",2))
  1. IF (($P($G(LCKCHK),"^")=0)!($P($G(LCKCHK),"^")=-1)),('$D(CHKLKER)) DO JUSTPAWS^XTVSLAPI($P(LCKCHK,"^",2))
  1. ;
  1. DO KILL
  1. Q
  1. ;
  1. REFRESH ; -- refresh display
  1. DO BUILD
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. MSG(TEXT) ; -- set default message
  1. IF $G(TEXT)]"" SET VALMSG=TEXT
  1. IF $G(TEXT)']"" SET VALMSG="Enter ?? for more actions and Help"
  1. QUIT
  1. ;
  1. KILL ; - Cleanup local and global display arrays
  1. DO CLEAN^VALM10 ;Kill data and video control arrays
  1. DO KILL^VALM10() ;Kill Video attributes
  1. DO CLNTMPGB
  1. KILL ^TMP("XTVS PKG MAN PARM DISP",$JOB)
  1. KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
  1. QUIT
  1. ;
  1. ;APIs
  1. LOADTMP(LINEITEM) ;Store LineItem into ^TMP global
  1. ;Input : LINEITEM - A single Package lineitem from XTMPSIZE.DAT
  1. ;
  1. ;Output: ^TMP array in the following form:
  1. ; ^TMP("{package name}","{primary prefix}")=LINEITEM [Package line from XTMPSIZE.DAT]
  1. ; ^TMP("{package name}","{primary prefix}","ADDPFX","{added prefix}")=""
  1. ; ^TMP("{package name}","{primary prefix}","F1-FLERNG","{file range 1}")="" [File # range from LOW-HIGH RANGE multiple]
  1. ; ^TMP("{package name}","{primary prefix}","F2-BEGFILE")=file number [Start file #]
  1. ; ^TMP("{package name}","{primary prefix}","F2-ENDFILE")=file number [Ending file #]
  1. ; ^TMP("{package name}","{primary prefix}","F3-FNUM",{file#})="" [File # from FILE NUMBER multiple]
  1. ; ^TMP("{package name}","{primary prefix}","PARENT")=Package [PARENT PACKAGE field]
  1. ; ^TMP("{package name}","{primary prefix}","REMPFX","{removed prefix}")=""
  1. ;
  1. NEW FSET,BEGFLNUM,ENDFLNUM,PCENUM,FNUM,APFX,APFXLST,FILELIST,PKGNAME,PKGPFX,RPFX,RPFXLST
  1. SET FSET=0
  1. SET PKGNAME=$P(LINEITEM,"^")
  1. SET PKGPFX=$P(LINEITEM,"^",2)
  1. SET BEGFLNUM=$P(LINEITEM,"^",3)
  1. SET ENDFLNUM=$P(LINEITEM,"^",4)
  1. ;
  1. ;Load package components into ^TMP Global (loop)
  1. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX)=LINEITEM ;Define Data node
  1. ;
  1. ;Define File Range array nodes
  1. SET FILELIST=$P(LINEITEM,"^",8)
  1. ;
  1. ;File Ranges [1st priority when defined]
  1. IF FILELIST'="" DO
  1. . SET PCENUM=0
  1. . FOR SET PCENUM=PCENUM+1 SET FLERNG=$P(FILELIST,"|",PCENUM) QUIT:FLERNG']"" DO
  1. .. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F1-FLERNG",FLERNG)=""
  1. .. DO FILNDX(FLERNG,PKGNAME,"FR",.FSET) ;Set ^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
  1. ;
  1. ;*Lowest File # & *Highest File # [2nd priority when defined and File Ranges Not defined]
  1. IF FILELIST="" DO
  1. . IF BEGFLNUM]"",ENDFLNUM]"" DO FILNDX(BEGFLNUM_"-"_ENDFLNUM,PKGNAME,"LH",.FSET) ;Set ^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
  1. ;
  1. ;*File List [3rd priority when defined and File Ranges & *Low/*High not defined]
  1. IF $P(LINEITEM,"^",7)'="" DO
  1. . SET FILELIST=$P(LINEITEM,"^",7)
  1. . SET PCENUM=0
  1. . FOR SET PCENUM=PCENUM+1 SET FNUM=$P(FILELIST,"|",PCENUM) QUIT:FNUM']"" DO
  1. .. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F3-FNUM",FNUM_"-"_FNUM)="" ;Define File Number array nodes
  1. .. DO:'FSET FILNDX(FNUM_"-"_FNUM,PKGNAME,"FL",FSET) ;Set ^TMP("XTVS-FRIDX",$J,<file #>,<file #>,<package name>)=""
  1. ;
  1. ;Define Start/End File number array nodes
  1. IF BEGFLNUM]"" SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F2-BEGFILE",BEGFLNUM_"-"_ENDFLNUM)=BEGFLNUM
  1. IF ENDFLNUM]"" SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F2-ENDFILE",BEGFLNUM_"-"_ENDFLNUM)=ENDFLNUM
  1. ;
  1. ;Define Additional & Excepted Prefix Array nodes
  1. SET APFXLST=PKGPFX_"|"_$P(LINEITEM,"^",5)
  1. SET RPFXLST=$P(LINEITEM,"^",6)
  1. SET PCENUM=0
  1. FOR SET PCENUM=PCENUM+1 SET APFX=($P(APFXLST,"|",PCENUM)) QUIT:APFX']"" DO
  1. . SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"ADDPFX",APFX)="" ;Additional Namespace
  1. . DO PFXIDX(APFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("XTVS-PFXIDX",$J,,<namespace prefix>,<package name>)="" [Additional & Excepted Prefixe Index]
  1. DO:PKGPFX]"" PFXIDX(PKGPFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("XTVS-PFXIDX",$J,<namespace prefix>,<package name>)="" [Primary Prefix index]
  1. ;
  1. SET PCENUM=0
  1. FOR SET PCENUM=PCENUM+1 SET RPFX=($P(RPFXLST,"|",PCENUM)) QUIT:RPFX']"" DO
  1. . SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"REMPFX",RPFX)="" ;Excepted Namespace
  1. ;
  1. ;Define Parent array node
  1. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"PARENT")=$P(LINEITEM,"^",9)
  1. ;
  1. QUIT
  1. ;
  1. ;
  1. ;"XTVS-FRIDX" USAGE NOTE: Supports File Range Overlap report
  1. ; In CHKFILE^XTVSLPR1, loop ^TMP("XTVS-FRIDX,"$J)
  1. ; Retrieve Begin/End Range values for "F1-FLERNG" [Subscripts 3 & 4]
  1. ; Check File Range of checked package for:
  1. ; If RNGEND < "F1-FLERNG" node begin # ...QUIT check
  1. ; If RNGBEG > "F1-FLERNG" node end # ...QUIT check
  1. ;
  1. ; If RNGBEG '< "F1-FLERNG" begin node, check for package name
  1. ; If not package name, create a File overlap error node indicating "F1-FLERNG" package, overlapping files and RNG package
  1. ; If RNGEND '> "F1-FLERNG" end node, check for package name
  1. ; If not package name, create a File overlap error node indicating "F1-FLERNG" package, overlapping files and RNG package
  1. ;
  1. FILNDX(FLRNGE,PKGNAME,TYPE,FSET) ; Set File Number Index [^TMP("XTVS-FRIDX",$J)]
  1. ;Input: FLRNGE - File Range
  1. ; PKGNAME - Package name
  1. ; TYPE - Type of File data
  1. ; FR : File Range multiple
  1. ; LH : *Lowest & *Highest fields
  1. ; FL : File List multiple
  1. ; FSET - File Data set indicator for ^XTMP("XTVS-FRIDX")
  1. ; 0 : Not set
  1. ; 1 : Set
  1. ;
  1. ;Output : File Range Node [^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""]
  1. ;
  1. ; <begin file #> and <end file #> are defined from the data in the following order:
  1. ; 1) Package 'File Range' multiple'
  1. ; If Overlap package 'File Range' is not defined, then...
  1. ; 2) Package file range defined by '*Lowest File#' & '*Highest File#'
  1. ;
  1. NEW BEGFNUM,ENDFNUM
  1. SET BEGFNUM=$P(FLRNGE,"-")
  1. SET ENDFNUM=$P(FLRNGE,"-",2)
  1. SET ^TMP("XTVS-FRIDX",$J,BEGFNUM,ENDFNUM,PKGNAME)=TYPE
  1. SET FSET=1
  1. QUIT
  1. ;
  1. ;
  1. ;"XTVS-PFXIDX" USAGE NOTE: Supports Prefix Overlap report
  1. ; In CHKPFX^XTVSLPR1, loop ^TMP("XTVS-PFXIDX",$J,<prefix>,<package name>)
  1. ; Extract Primary Prefix (4th subscript) and added Prefixes from "ADDPFX" (6th subscript)
  1. ; If <package name> in Array subscript doesn't equal "package name"...
  1. ; create a Prefix overlap error node indicating "ADDPFX" package, overlapping prefix and "PFXIDX" package [MLTPFX^XTVSLPR1]
  1. ;
  1. PFXIDX(PKGPFX,PKGNAME,PFXLST) ;Set ^TMP("XTVS-PFXIDX",$J,<namespace prefix>,<package name>)=<list of prefixes>
  1. SET PFXLST=$G(PFXLST)
  1. SET ^TMP("XTVS-PFXIDX",$J,PKGPFX,PKGNAME)=PFXLST
  1. QUIT
  1. ;
  1. SCAPARY(LINEITEM) ; Set single line Array & caption display array for action processing
  1. NEW PARMDAT,PKG
  1. ;
  1. ;Set Caption Display Array
  1. SET PKG=$P(LINEITEM,"^")
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG)=LINEITEM
  1. SET PARMDAT=$P(LINEITEM,"^")
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,1,"Package Name")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",2)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,2,"Primary Prefix")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",3)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,3,"*Lowest File#")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",4)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,4,"*Highest File#")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",5)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,5,"Additional Prefixes")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",6)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,6,"Excepted Prefixes")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",7)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,7,"File Numbers")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",8)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,8,"File Ranges")=PARMDAT
  1. SET PARMDAT=$P(LINEITEM,"^",9)
  1. SET ^TMP("XTVS-PARAM-CAP",$J,PKG,9,"Parent Package")=PARMDAT
  1. QUIT
  1. ;
  1. CLNTMPGB ;Kill temporary globals
  1. KILL ^TMP("XTVS-PKGEDIT",$J),^TMP("XTVS-ERROR",$J),^TMP("XTVS-FRIDX",$J),^TMP("XTVS-PFXIDX",$J)
  1. KILL ^TMP("XTVS-PARAM-CAP",$J)
  1. QUIT
  1. ;
  1. PRMFLIST(FLESRCH,PAWSOUT) ;List parameter files for selection
  1. NEW DEFDIR,FILENME,FILELIST,LSTRSLT,SELARY,ITEMNUM,XVAL
  1. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. IF $G(FLESRCH)="" SET FLESRCH="XTMPSIZE*"
  1. IF $G(PAWSOUT)="" SET PAWSOUT=" There are no XTMPSIZE files for comparison!"
  1. SET FILENME(FLESRCH)=""
  1. SET LSTRSLT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
  1. SET FILENME=""
  1. IF LSTRSLT DO
  1. .; Move XTMPSIZE files to SELARY
  1. .SET ITEMNUM=0
  1. .FOR SET FILENME=$O(FILELIST(FILENME)) Q:FILENME="" DO
  1. ..IF (FLESRCH'[".LCK"),(FILENME'[".LCK") SET ITEMNUM=ITEMNUM+1 SET SELARY(ITEMNUM)=FILENME ;Parameter list
  1. ..IF (FLESRCH[".LCK") SET ITEMNUM=ITEMNUM+1 SET SELARY(ITEMNUM)=FILENME ; Lock list
  1. .;
  1. .IF ITEMNUM>0 DO
  1. .. NEW PARAMSTR,QSTHLP1
  1. .. IF FLESRCH'[".LCK" DO
  1. ... SET QSTHLP1=" Enter the name or number (1-"_ITEMNUM_") of the desired parameter file to compare."
  1. ... SET PARAMSTR("MINLNG")=10
  1. ..;
  1. .. IF FLESRCH[".LCK" DO
  1. ... DO LISTOUT^XTVSLAPI(.SELARY)
  1. ... SET QSTHLP1=" Enter the name or number (1-"_ITEMNUM_") LOCK to release."
  1. ... SET PARAMSTR("MINLNG")=8
  1. ..;
  1. .. SET PARAMSTR("PATRN")="1""XTMPSIZE"".ANP"
  1. .. SET PARAMSTR("DEFANS")=""
  1. .. SET PARAMSTR("MAXLNG")=30
  1. .. SET PARAMSTR("ADDITM")=0
  1. .. SET XVAL=+$$SELITEM(QSTHLP1,.ITEMNUM,.SELARY,.PARAMSTR)
  1. .. ;
  1. ..IF (+$G(XVAL)>0)&(+$G(XVAL)<(ITEMNUM+1)) SET FILENME=SELARY(XVAL) W " ",FILENME
  1. ..IF ITEMNUM'>0 DO JUSTPAWS^XTVSLAPI(PAWSOUT)
  1. ;
  1. IF 'LSTRSLT DO JUSTPAWS^XTVSLAPI(PAWSOUT)
  1. QUIT FILENME
  1. ;
  1. SELITEM(QSTHLP1,ITEMNUM,SELARY,PARAMSTR) ; Select Package Parameter file from SELARY
  1. ; INPUT: QSTHLP1 - Help string for 1 question mark help [Optional]
  1. ; ITEMNUM - Number of items in SELARY
  1. ; SELARY - Array of Package Parameter files
  1. ; PARAMSTR - Array of string parameters as follows:
  1. ; PARAMSTR("ADDITM") - 0: Adding item to SELARY NOT Allowed; 1: Adding unique item to SELARY Allowed 1^1: Add duplicates allowed
  1. ; PARAMSTR("DEFANS") - Only pertains to Package selection. Not Null: Last selected Package
  1. ; PARAMSTR("MAXLNG") - Maximum length of entered string [default 30, or 10 more than MINLNG when MINLNG>MAXLNG]
  1. ; PARAMSTR("MINLNG") - Minumum length of entered string [default 10] - DEV NOTE: MINLNG must be > or = #Chars in PATRN begin & end strings
  1. ; PARAMSTR("PATRN") - Pattern match definition for text [default .ANP)
  1. ; PARAMSTR("XTUPCASE") - 0: case matters, 1: All item text translated to upper case [default]
  1. ;
  1. ;
  1. ; OUTPUT: Y - Item # for selected Parameter file
  1. ;
  1. NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,MINLG,MAXLG,ADDITEM,DEFANS
  1. IF +$G(PARAMSTR("ADDITM"))=0 SET ADDITEM=0 ;Default - No adding items
  1. IF +$G(PARAMSTR("ADDITM"))>0 SET ADDITEM=+$G(PARAMSTR("ADDITM"))
  1. IF $G(PARAMSTR("XTUPCASE"))="" SET PARAMSTR("XTUPCASE")=1
  1. IF $G(PARAMSTR("PATRN"))="" SET PARAMSTR("PATRN")=".ANP"
  1. SET DEFANS=$G(PARAMSTR("DEFANS"))
  1. SET MINLG=+$G(PARAMSTR("MINLNG"))
  1. SET MAXLG=+$G(PARAMSTR("MAXLNG"))
  1. IF MINLG=0 SET (MINLG,PARAMSTR("MINLNG"))=10
  1. IF (MINLG<30),(MINLG>MAXLG) SET (MAXLG,PARAMSTR("MAXLNG"))=30
  1. IF (MINLG>29),(MINLG>MAXLG) SET PARAMSTR("MAXLNG")=MINLG+10
  1. SET DIR("A")="Select File: "
  1. SET DIR(0)="NAO^1:"_(ITEMNUM+1)_"^K:(X'?.N) X I $D(X),(X>ITEMNUM) K X"
  1. SET DIR("PRE")="D PRECHK^XTVSLP(DEFANS,.X,.SELARY,.ITEMNUM)"
  1. IF '$D(QSTHLP1) DO
  1. . SET DIR("?",1)=" Enter the name or number (1-"_ITEMNUM_") of the desired item."
  1. . IF '$P(ADDITEM,"^",2) SET DIR("?",2)=" Duplicates are not allowed."
  1. . SET DIR("?")=" [Enter '??' for a numbered list of items OR '^' to exit]"
  1. IF $D(QSTHLP1) DO
  1. . SET DIR("?",1)=QSTHLP1
  1. . IF QSTHLP1'["LOCK" DO
  1. .. IF 'ADDITEM SET DIR("?",2)=" New items cannot be added."
  1. .. IF ADDITEM,('$P(ADDITEM,"^",2)) SET DIR("?",2)=" New items can be added but duplicates are not allowed."
  1. . SET DIR("?")=" [Enter '??' for a numbered list of items OR '^' to exit]"
  1. SET DIR("??")="^DO LISTOUT^XTVSLAPI(.SELARY)"
  1. DO ^DIR
  1. QUIT Y
  1. ;
  1. PRECHK(DEFANS,X,SELARY,ITEMNUM) ; SELITEM X value DIR("PRE") pre-check
  1. IF X=" ",$G(DEFANS)]"" SET X=DEFANS W " ",X
  1. IF X]"",'$D(DTOUT),$E(X,1)'="^" DO
  1. . IF ((X'?.N)&($E(X,1)'["?")) DO SELLIST^XTVSLPR2(.SELARY,.ITEMNUM,.X,.PARAMSTR)
  1. QUIT
  1. ;
  1. PARMMAP ; Map of Parameter data elements
  1. ;
  1. ;Parameter List data map to Package file (#9.4):
  1. ;-----------------------------------------------
  1. ; ^ pce 1 : Package Name
  1. ; [Source: NAME (#.01)]
  1. ; ^ pce 2 : Primary Prefix
  1. ; [Source: PREFIX (#1)]
  1. ; ^ pce 3 : *Lowest File #
  1. ; [Source: *LOWEST FILE NUMBER (#10.6)]
  1. ; ^ pce 4 : *Highest File #
  1. ; [Source: *HIGHEST FILE NUMBER (#11)]
  1. ; ^ pce 5 : Pipe character (|) delimited list of Additional Prefixes
  1. ; [Source: ADDITIONAL PREFIXES multiple (#14)]
  1. ; ^ pce 6 : Pipe character (|) delimited list of Excepted Prefixes
  1. ; [Source: EXCLUDED NAME SPACE multiple (#919)]
  1. ; ^ pce 7 : Pipe character (|) delimited list of File Number entries
  1. ; [Source: FILE NUMBER multiple (#15001)]
  1. ; ^ pce 8 : Pipe character (|) delimited list of File Range entries
  1. ; [Source: LOW-HIGH RANGE multiple (#15001.1)]
  1. ; ^ pce 9 : Parent Package
  1. ; [Source: PARENT PACKAGE field (#15003)]
  1. ;
  1. ;$END
  1. ;
  1. ;PROTOCOL entry points
  1. ;
  1. PKGERR ; -- Package Parameter Errors
  1. ; -- Protocol: XTVS PKG MGR PARAM ERR DISP ACTION
  1. DO EN^XTVSLPER
  1. DO REFRESH
  1. DO MSG
  1. QUIT
  1. ;
  1. PARAMRPT ; -- Package Parameter Caption list
  1. ; -- Protocol: XTVS PKG MGR PARAM DISP CAPTION ACTION
  1. NEW LCKCHK
  1. DO EN^XTVSLPDC
  1. SET LCKCHK=$$CHKPID^XTVSLAPI($$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I"),XTVPSPRM)
  1. IF $P(LCKCHK,"^")=1 DO
  1. . DO REFRESH
  1. . DO MSG
  1. IF $P(LCKCHK,"^")'=1 S VALMQUIT=""
  1. QUIT
  1. ;
  1. PARAMAP ; -- Display Data Map for Parameter File
  1. ; -- Protocol: XTVS PKG MGR PARAM DATA MAP HELP ACTION
  1. NEW HLPTEXT,LNENUM
  1. DO FULL^VALM1
  1. FOR LNENUM=1:1 SET HLPTEXT=$P($TEXT(PARMMAP+LNENUM),";",2) Q:HLPTEXT="$END" W !,HLPTEXT
  1. DO JUSTPAWS^XTVSLAPI
  1. ;
  1. DO REFRESH
  1. DO MSG
  1. QUIT
  1. ;
  1. PARAMCMP ; -- Package Parameter Comparison report
  1. ; -- Protocol: XTVS PKG MGR PARAM COMPARE ACTION
  1. NEW CMPRFNME
  1. DO FULL^VALM1
  1. SET CMPRFNME=$$PRMFLIST^XTVSLP() ;Select a File to compare
  1. IF CMPRFNME["XTMPSIZE" DO
  1. . DO EN^XTVSLPC(CMPRFNME)
  1. IF CMPRFNME'["XTMPSIZE" DO JUSTPAWS^XTVSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
  1. DO REFRESH
  1. DO MSG
  1. QUIT