XTVSLP ;Albany FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
EN ; -- main entry point for XTVS PKG MGR PARAM DISPLAY
D EN^VALM("XTVS PKG MGR PARAM DISPLAY")
Q
;
HDR ; -- header code
NEW DEFDIR,SPCPAD,DIRHEAD
SET SPCPAD=""
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Parameter Display"
SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
SET DIRHEAD="Default Directory: "_DEFDIR
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(3)=SPCPAD_DIRHEAD
SET SPCPAD=""
SET DIRHEAD="Parameter file: "_XTVPSPRM
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(4)=SPCPAD_DIRHEAD
DO MSG
QUIT
;
BUILD ; - Build local and global display arrays
NEW DEFDIR
DO KILL ;Kill all processing & data arrays and video attributes & control arrays
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"R")
U IO
SET VALMCNT=0
FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
. IF LINEITEM]"" DO
.. DO SCAPARY(LINEITEM) ;Creates ^TMP("XTVS-PARAM-CAP",$J) array
.. DO SPLITADD^XTVSLAPI(.VALMCNT,LINEITEM,1)
.. DO LOADTMP(LINEITEM) ;Store LineItem into ^TMP global & Index
D CLOSE^%ZISH("XTMP")
QUIT
;
INIT ; -- init variables and list array
IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO
. NEW XTTMPLNN,CHKLKER
. SET XTTMPLNN=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM,5)
. IF +XTTMPLNN>0 DO
.. SET XTVPSPRM=$P($G(^TMP("XTVS PACKAGE MGR",$J,XTTMPLNN,0)),XTTMPLNN-5_") ",2)
.. SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
.. IF 'CHKLKER DO
... IF XTVPSPRM]"" DO BUILD
... IF XTVPSPRM']"" SET VALMQUIT=""
.. IF CHKLKER W !!," <* LOCK request denied! Try again later. *>"
.. DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
.. IF CHKLKER DO EXIT^XTVSLP S VALMQUIT=""
. IF XTTMPLNN=-1 S VALMQUIT=""
QUIT
;
HELP ; -- help code
IF $D(X),X'["??" DO
. SET X="?"
. DO DISP^XQORM1 W !
IF $D(X),X["??" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. WRITE !,"Parameter Display action help..."
. WRITE !,"List specific actions:",!
. DO DISP^XQORM1 W !!
. SET XTQVAR=Y
. IF XTQVAR DO
.. SET XTQVAR=0
.. FOR TXTCT=1:1 SET XTX=$P($T(LPTXT+TXTCT^XTVSHLP1),";",3,99) QUIT:XTX="$END" QUIT:XTQVAR DO
... IF XTX="$PAUSE" DO PAUSE^VALM1 D:Y CLEAR^VALM1 IF 'Y SET XTQVAR=1 QUIT
... W !,$S(XTX["$PAUSE":"",1:XTX)
. W !
S VALMBCK="R"
D MSG
K XTX,Y,TXTCT,XTQVAR
Q
;
EXIT ; -- exit code
NEW DEFDIR,LCKCHK
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
IF $G(XTVPSPRM)]"" SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
DO FULL^VALM1
IF ($P($G(LCKCHK),"^")=1) DO
. NEW UNLKRSLT
. SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
. IF ($P(UNLKRSLT,"^")'=1) W !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
. DO JUSTPAWS^XTVSLAPI($P(UNLKRSLT,"^",2))
IF (($P($G(LCKCHK),"^")=0)!($P($G(LCKCHK),"^")=-1)),('$D(CHKLKER)) DO JUSTPAWS^XTVSLAPI($P(LCKCHK,"^",2))
;
DO KILL
Q
;
REFRESH ; -- refresh display
DO BUILD
SET VALMBCK="R"
QUIT
;
MSG(TEXT) ; -- set default message
IF $G(TEXT)]"" SET VALMSG=TEXT
IF $G(TEXT)']"" SET VALMSG="Enter ?? for more actions and Help"
QUIT
;
KILL ; - Cleanup local and global display arrays
DO CLEAN^VALM10 ;Kill data and video control arrays
DO KILL^VALM10() ;Kill Video attributes
DO CLNTMPGB
KILL ^TMP("XTVS PKG MAN PARM DISP",$JOB)
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
;APIs
LOADTMP(LINEITEM) ;Store LineItem into ^TMP global
;Input : LINEITEM - A single Package lineitem from XTMPSIZE.DAT
;
;Output: ^TMP array in the following form:
; ^TMP("{package name}","{primary prefix}")=LINEITEM [Package line from XTMPSIZE.DAT]
; ^TMP("{package name}","{primary prefix}","ADDPFX","{added prefix}")=""
; ^TMP("{package name}","{primary prefix}","F1-FLERNG","{file range 1}")="" [File # range from LOW-HIGH RANGE multiple]
; ^TMP("{package name}","{primary prefix}","F2-BEGFILE")=file number [Start file #]
; ^TMP("{package name}","{primary prefix}","F2-ENDFILE")=file number [Ending file #]
; ^TMP("{package name}","{primary prefix}","F3-FNUM",{file#})="" [File # from FILE NUMBER multiple]
; ^TMP("{package name}","{primary prefix}","PARENT")=Package [PARENT PACKAGE field]
; ^TMP("{package name}","{primary prefix}","REMPFX","{removed prefix}")=""
;
NEW FSET,BEGFLNUM,ENDFLNUM,PCENUM,FNUM
SET FSET=0
SET PKGNAME=$P(LINEITEM,"^")
SET PKGPFX=$P(LINEITEM,"^",2)
SET BEGFLNUM=$P(LINEITEM,"^",3)
SET ENDFLNUM=$P(LINEITEM,"^",4)
;
;Load package components into ^TMP Global (loop)
SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX)=LINEITEM ;Define Data node
;
;Define File Range array nodes
SET FILELIST=$P(LINEITEM,"^",8)
;
;File Ranges [1st priority when defined]
IF FILELIST'="" DO
. SET PCENUM=0
. FOR SET PCENUM=PCENUM+1 SET FLERNG=$P(FILELIST,"|",PCENUM) QUIT:FLERNG']"" DO
.. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F1-FLERNG",FLERNG)=""
.. DO FILNDX(FLERNG,PKGNAME,"FR",.FSET) ;Set ^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
;
;*Lowest File # & *Highest File # [2nd priority when defined and File Ranges Not defined]
IF FILELIST="" DO
. IF BEGFLNUM]"",ENDFLNUM]"" DO FILNDX(BEGFLNUM_"-"_ENDFLNUM,PKGNAME,"LH",.FSET) ;Set ^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
;
;*File List [3rd priority when defined and File Ranges & *Low/*High not defined]
IF $P(LINEITEM,"^",7)'="" DO
. SET FILELIST=$P(LINEITEM,"^",7)
. SET PCENUM=0
. FOR SET PCENUM=PCENUM+1 SET FNUM=$P(FILELIST,"|",PCENUM) QUIT:FNUM']"" DO
.. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F3-FNUM",FNUM_"-"_FNUM)="" ;Define File Number array nodes
.. DO:'FSET FILNDX(FNUM_"-"_FNUM,PKGNAME,"FL",FSET) ;Set ^TMP("XTVS-FRIDX",$J,<file #>,<file #>,<package name>)=""
;
;Define Start/End File number array nodes
IF BEGFLNUM]"" SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F2-BEGFILE",BEGFLNUM_"-"_ENDFLNUM)=BEGFLNUM
IF ENDFLNUM]"" SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"F2-ENDFILE",BEGFLNUM_"-"_ENDFLNUM)=ENDFLNUM
;
;Define Additional & Excepted Prefix Array nodes
SET APFXLST=PKGPFX_"|"_$P(LINEITEM,"^",5)
SET RPFXLST=$P(LINEITEM,"^",6)
SET PCENUM=0
FOR SET PCENUM=PCENUM+1 SET APFX=($P(APFXLST,"|",PCENUM)) QUIT:APFX']"" DO
. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"ADDPFX",APFX)="" ;Additional Namespace
. DO PFXIDX(APFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("XTVS-PFXIDX",$J,,<namespace prefix>,<package name>)="" [Additional & Excepted Prefixe Index]
DO:PKGPFX]"" PFXIDX(PKGPFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("XTVS-PFXIDX",$J,<namespace prefix>,<package name>)="" [Primary Prefix index]
;
SET PCENUM=0
FOR SET PCENUM=PCENUM+1 SET RPFX=($P(RPFXLST,"|",PCENUM)) QUIT:RPFX']"" DO
. SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"REMPFX",RPFX)="" ;Excepted Namespace
;
;Define Parent array node
SET ^TMP("XTVS-PKGEDIT",$J,PKGNAME,PKGPFX,"PARENT")=$P(LINEITEM,"^",9)
;
QUIT
;
;
;"XTVS-FRIDX" USAGE NOTE: Supports File Range Overlap report
; In CHKFILE^XTVSLPR1, loop ^TMP("XTVS-FRIDX,"$J)
; Retrieve Begin/End Range values for "F1-FLERNG" [Subscripts 3 & 4]
; Check File Range of checked package for:
; If RNGEND < "F1-FLERNG" node begin # ...QUIT check
; If RNGBEG > "F1-FLERNG" node end # ...QUIT check
;
; If RNGBEG '< "F1-FLERNG" begin node, check for package name
; If not package name, create a File overlap error node indicating "F1-FLERNG" package, overlapping files and RNG package
; If RNGEND '> "F1-FLERNG" end node, check for package name
; If not package name, create a File overlap error node indicating "F1-FLERNG" package, overlapping files and RNG package
;
FILNDX(FLRNGE,PKGNAME,TYPE,FSET) ; Set File Number Index [^TMP("XTVS-FRIDX",$J)]
;Input: FLRNGE - File Range
; PKGNAME - Package name
; TYPE - Type of File data
; FR : File Range multiple
; LH : *Lowest & *Highest fields
; FL : File List multiple
; FSET - File Data set indicator for ^XTMP("XTVS-FRIDX")
; 0 : Not set
; 1 : Set
;
;Output : File Range Node [^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""]
;
; <begin file #> and <end file #> are defined from the data in the following order:
; 1) Package 'File Range' multiple'
; If Overlap package 'File Range' is not defined, then...
; 2) Package file range defined by '*Lowest File#' & '*Highest File#'
;
NEW BEGFNUM,ENDFNUM
SET BEGFNUM=$P(FLRNGE,"-")
SET ENDFNUM=$P(FLRNGE,"-",2)
SET ^TMP("XTVS-FRIDX",$J,BEGFNUM,ENDFNUM,PKGNAME)=TYPE
SET FSET=1
QUIT
;
;
;"XTVS-PFXIDX" USAGE NOTE: Supports Prefix Overlap report
; In CHKPFX^XTVSLPR1, loop ^TMP("XTVS-PFXIDX",$J,<prefix>,<package name>)
; Extract Primary Prefix (4th subscript) and added Prefixes from "ADDPFX" (6th subscript)
; If <package name> in Array subscript doesn't equal "package name"...
; create a Prefix overlap error node indicating "ADDPFX" package, overlapping prefix and "PFXIDX" package [MLTPFX^XTVSLPR1]
;
PFXIDX(PKGPFX,PKGNAME,PFXLST) ;Set ^TMP("XTVS-PFXIDX",$J,<namespace prefix>,<package name>)=<list of prefixes>
SET PFXLST=$G(PFXLST)
SET ^TMP("XTVS-PFXIDX",$J,PKGPFX,PKGNAME)=PFXLST
QUIT
;
SCAPARY(LINEITEM) ; Set single line Array & caption display array for action processing
NEW PARMDAT,PKG
;
;Set Caption Display Array
SET PKG=$P(LINEITEM,"^")
SET ^TMP("XTVS-PARAM-CAP",$J,PKG)=LINEITEM
SET PARMDAT=$P(LINEITEM,"^")
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,1,"Package Name")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",2)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,2,"Primary Prefix")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",3)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,3,"*Lowest File#")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",4)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,4,"*Highest File#")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",5)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,5,"Additional Prefixes")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",6)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,6,"Excepted Prefixes")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",7)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,7,"File Numbers")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",8)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,8,"File Ranges")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",9)
SET ^TMP("XTVS-PARAM-CAP",$J,PKG,9,"Parent Package")=PARMDAT
QUIT
;
CLNTMPGB ;Kill temporary globals
KILL ^TMP("XTVS-PKGEDIT",$J),^TMP("XTVS-ERROR",$J),^TMP("XTVS-FRIDX",$J),^TMP("XTVS-PFXIDX",$J)
KILL ^TMP("XTVS-PARAM-CAP",$J)
QUIT
;
PRMFLIST(FLESRCH,PAWSOUT) ;List parameter files for selection
NEW DEFDIR,FILENME,FILELIST,LSTRSLT,SELARY,ITEMNUM
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
IF $G(FLESRCH)="" SET FLESRCH="XTMPSIZE*"
IF $G(PAWSOUT)="" SET PAWSOUT=" There are no XTMPSIZE files for comparison!"
SET FILENME(FLESRCH)=""
SET LSTRSLT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
SET FILENME=""
IF LSTRSLT DO
.; Move XTMPSIZE files to SELARY
.SET ITEMNUM=0
.FOR SET FILENME=$O(FILELIST(FILENME)) Q:FILENME="" DO
..IF (FLESRCH'[".LCK"),(FILENME'[".LCK") SET ITEMNUM=ITEMNUM+1 SET SELARY(ITEMNUM)=FILENME ;Parameter list
..IF (FLESRCH[".LCK") SET ITEMNUM=ITEMNUM+1 SET SELARY(ITEMNUM)=FILENME ; Lock list
.;
.IF ITEMNUM>0 DO
.. DO LISTOUT^XTVSLAPI(.SELARY) ;List Parameter files for selection
.. SET XVAL=+$$SELPKG(ITEMNUM,.SELARY)
.. ;
..IF (+$G(XVAL)>0)&(+$G(XVAL)<(ITEMNUM+1)) SET FILENME=SELARY(XVAL) W " ",FILENME
..IF ITEMNUM'>0 DO JUSTPAWS^XTVSLAPI(PAWSOUT)
;
IF 'LSTRSLT DO JUSTPAWS^XTVSLAPI(PAWSOUT)
QUIT FILENME
;
SELPKG(ITEMNUM,SELARY) ; Select Package to Edit from ^TMP("XTVS PKG MGR PARAM CAP",$J)
; INPUT: SELARY - Array of packages
; ITEMNUM - Number of items in SELARY
;
; OUTPUT: PKGNME - Name of selected package
;
NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
SET DIR("A")="Select File: "
SET DIR(0)="NAO^1:"_ITEMNUM_"^K:(X'?.N) X"
SET DIR("?",1)=" Select item # for the desired file from the list."
SET DIR("?")=" [Enter'^' to exit]"
SET DIR("??")="^DO LISTOUT^XTVSLAPI(.SELARY)"
DO ^DIR
QUIT Y
;
;
PARMMAP ; Map of Parameter data elements
;
;Parameter List data map to Package file (#9.4):
;-----------------------------------------------
; ^ pce 1 : Package Name
; [Source: NAME (#.01)]
; ^ pce 2 : Primary Prefix
; [Source: PREFIX (#1)]
; ^ pce 3 : *Lowest File #
; [Source: *LOWEST FILE NUMBER (#10.6)]
; ^ pce 4 : *Highest File #
; [Source: *HIGHEST FILE NUMBER (#11)]
; ^ pce 5 : Pipe character (|) delimited list of Additional Prefixes
; [Source: ADDITIONAL PREFIXES multiple (#14)]
; ^ pce 6 : Pipe character (|) delimited list of Excepted Prefixes
; [Source: EXCLUDED NAME SPACE multiple (#919)]
; ^ pce 7 : Pipe character (|) delimited list of File Number entries
; [Source: FILE NUMBER multiple (#15001)]
; ^ pce 8 : Pipe character (|) delimited list of File Range entries
; [Source: LOW-HIGH RANGE multiple (#15001.1)]
; ^ pce 9 : Parent Package
; [Source: PARENT PACKAGE field (#15003)]
;
;$END
;
;PROTOCOL entry points
;
PKGERR ; -- Package Parameter Errors
; -- Protocol: XTVS PKG MGR PARAM ERR DISP ACTION
DO EN^XTVSLPER
DO REFRESH
DO MSG
QUIT
;
PARAMRPT ; -- Package Parameter Caption list
; -- Protocol: XTVS PKG MGR PARAM DISP CAPTION ACTION
NEW LCKCHK
DO EN^XTVSLPDC
SET LCKCHK=$$CHKPID^XTVSLAPI($$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I"),XTVPSPRM)
IF $P(LCKCHK,"^")=1 DO
. DO REFRESH
. DO MSG
IF $P(LCKCHK,"^")'=1 S VALMQUIT=""
QUIT
;
PARAMAP ; -- Display Data Map for Parameter File
; -- Protocol: XTVS PKG MGR PARAM DATA MAP HELP ACTION
NEW HLPTEXT,LNENUM
DO FULL^VALM1
FOR LNENUM=1:1 SET HLPTEXT=$P($TEXT(PARMMAP+LNENUM),";",2) Q:HLPTEXT="$END" W !,HLPTEXT
DO JUSTPAWS^XTVSLAPI
;
DO REFRESH
DO MSG
QUIT
;
PARAMCMP ; -- Package Parameter Comparison report
; -- Protocol: XTVS PKG MGR PARAM COMPARE ACTION
NEW CMPRFNME
DO FULL^VALM1
SET CMPRFNME=$$PRMFLIST^XTVSLP() ;Select a File to compare
IF CMPRFNME["XTMPSIZE" DO
. DO EN^XTVSLPC(CMPRFNME)
IF CMPRFNME'["XTMPSIZE" DO JUSTPAWS^XTVSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
DO REFRESH
DO MSG
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLP 14669 printed Oct 16, 2024@18:42:48 Page 2
XTVSLP ;Albany FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
+1 ;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
EN ; -- main entry point for XTVS PKG MGR PARAM DISPLAY
+1 DO EN^VALM("XTVS PKG MGR PARAM DISPLAY")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW DEFDIR,SPCPAD,DIRHEAD
+2 SET SPCPAD=""
+3 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Parameter Display"
+5 SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
+6 SET DIRHEAD="Default Directory: "_DEFDIR
+7 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+8 SET VALMHDR(3)=SPCPAD_DIRHEAD
+9 SET SPCPAD=""
+10 SET DIRHEAD="Parameter file: "_XTVPSPRM
+11 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+12 SET VALMHDR(4)=SPCPAD_DIRHEAD
+13 DO MSG
+14 QUIT
+15 ;
BUILD ; - Build local and global display arrays
+1 NEW DEFDIR
+2 ;Kill all processing & data arrays and video attributes & control arrays
DO KILL
+3 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+4 DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"R")
+5 USE IO
+6 SET VALMCNT=0
+7 FOR
SET LINEITEM=""
READ LINEITEM:5
if $$STATUS^%ZISH
QUIT
Begin DoDot:1
+8 IF LINEITEM]""
Begin DoDot:2
+9 ;Creates ^TMP("XTVS-PARAM-CAP",$J) array
DO SCAPARY(LINEITEM)
+10 DO SPLITADD^XTVSLAPI(.VALMCNT,LINEITEM,1)
+11 ;Store LineItem into ^TMP global & Index
DO LOADTMP(LINEITEM)
End DoDot:2
End DoDot:1
+12 DO CLOSE^%ZISH("XTMP")
+13 QUIT
+14 ;
INIT ; -- init variables and list array
+1 IF (+$GET(FIRSTITM)>0)
IF ($GET(LASTITM)>0)
Begin DoDot:1
+2 NEW XTTMPLNN,CHKLKER
+3 SET XTTMPLNN=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM,5)
+4 IF +XTTMPLNN>0
Begin DoDot:2
+5 SET XTVPSPRM=$PIECE($GET(^TMP("XTVS PACKAGE MGR",$JOB,XTTMPLNN,0)),XTTMPLNN-5_") ",2)
+6 SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
+7 IF 'CHKLKER
Begin DoDot:3
+8 IF XTVPSPRM]""
DO BUILD
+9 IF XTVPSPRM']""
SET VALMQUIT=""
End DoDot:3
+10 IF CHKLKER
WRITE !!," <* LOCK request denied! Try again later. *>"
+11 DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
+12 IF CHKLKER
DO EXIT^XTVSLP
SET VALMQUIT=""
End DoDot:2
+13 IF XTTMPLNN=-1
SET VALMQUIT=""
End DoDot:1
+14 QUIT
+15 ;
HELP ; -- help code
+1 IF $DATA(X)
IF X'["??"
Begin DoDot:1
+2 SET X="?"
+3 DO DISP^XQORM1
WRITE !
End DoDot:1
+4 IF $DATA(X)
IF X["??"
Begin DoDot:1
+5 DO CLEAR^VALM1
+6 DO FULL^VALM1
+7 WRITE !,"Parameter Display action help..."
+8 WRITE !,"List specific actions:",!
+9 DO DISP^XQORM1
WRITE !!
+10 SET XTQVAR=Y
+11 IF XTQVAR
Begin DoDot:2
+12 SET XTQVAR=0
+13 FOR TXTCT=1:1
SET XTX=$PIECE($TEXT(LPTXT+TXTCT^XTVSHLP1),";",3,99)
if XTX="$END"
QUIT
if XTQVAR
QUIT
Begin DoDot:3
+14 IF XTX="$PAUSE"
DO PAUSE^VALM1
if Y
DO CLEAR^VALM1
IF 'Y
SET XTQVAR=1
QUIT
+15 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
End DoDot:3
End DoDot:2
+16 WRITE !
End DoDot:1
+17 SET VALMBCK="R"
+18 DO MSG
+19 KILL XTX,Y,TXTCT,XTQVAR
+20 QUIT
+21 ;
EXIT ; -- exit code
+1 NEW DEFDIR,LCKCHK
+2 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+3 IF $GET(XTVPSPRM)]""
SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
+4 DO FULL^VALM1
+5 IF ($PIECE($GET(LCKCHK),"^")=1)
Begin DoDot:1
+6 NEW UNLKRSLT
+7 SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(XTVPSPRM)
+8 IF ($PIECE(UNLKRSLT,"^")'=1)
WRITE !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
+9 DO JUSTPAWS^XTVSLAPI($PIECE(UNLKRSLT,"^",2))
End DoDot:1
+10 IF (($PIECE($GET(LCKCHK),"^")=0)!($PIECE($GET(LCKCHK),"^")=-1))
IF ('$DATA(CHKLKER))
DO JUSTPAWS^XTVSLAPI($PIECE(LCKCHK,"^",2))
+11 ;
+12 DO KILL
+13 QUIT
+14 ;
REFRESH ; -- refresh display
+1 DO BUILD
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
MSG(TEXT) ; -- set default message
+1 IF $GET(TEXT)]""
SET VALMSG=TEXT
+2 IF $GET(TEXT)']""
SET VALMSG="Enter ?? for more actions and Help"
+3 QUIT
+4 ;
KILL ; - Cleanup local and global display arrays
+1 ;Kill data and video control arrays
DO CLEAN^VALM10
+2 ;Kill Video attributes
DO KILL^VALM10()
+3 DO CLNTMPGB
+4 KILL ^TMP("XTVS PKG MAN PARM DISP",$JOB)
+5 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+6 QUIT
+7 ;
+8 ;APIs
LOADTMP(LINEITEM) ;Store LineItem into ^TMP global
+1 ;Input : LINEITEM - A single Package lineitem from XTMPSIZE.DAT
+2 ;
+3 ;Output: ^TMP array in the following form:
+4 ; ^TMP("{package name}","{primary prefix}")=LINEITEM [Package line from XTMPSIZE.DAT]
+5 ; ^TMP("{package name}","{primary prefix}","ADDPFX","{added prefix}")=""
+6 ; ^TMP("{package name}","{primary prefix}","F1-FLERNG","{file range 1}")="" [File # range from LOW-HIGH RANGE multiple]
+7 ; ^TMP("{package name}","{primary prefix}","F2-BEGFILE")=file number [Start file #]
+8 ; ^TMP("{package name}","{primary prefix}","F2-ENDFILE")=file number [Ending file #]
+9 ; ^TMP("{package name}","{primary prefix}","F3-FNUM",{file#})="" [File # from FILE NUMBER multiple]
+10 ; ^TMP("{package name}","{primary prefix}","PARENT")=Package [PARENT PACKAGE field]
+11 ; ^TMP("{package name}","{primary prefix}","REMPFX","{removed prefix}")=""
+12 ;
+13 NEW FSET,BEGFLNUM,ENDFLNUM,PCENUM,FNUM
+14 SET FSET=0
+15 SET PKGNAME=$PIECE(LINEITEM,"^")
+16 SET PKGPFX=$PIECE(LINEITEM,"^",2)
+17 SET BEGFLNUM=$PIECE(LINEITEM,"^",3)
+18 SET ENDFLNUM=$PIECE(LINEITEM,"^",4)
+19 ;
+20 ;Load package components into ^TMP Global (loop)
+21 ;Define Data node
SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX)=LINEITEM
+22 ;
+23 ;Define File Range array nodes
+24 SET FILELIST=$PIECE(LINEITEM,"^",8)
+25 ;
+26 ;File Ranges [1st priority when defined]
+27 IF FILELIST'=""
Begin DoDot:1
+28 SET PCENUM=0
+29 FOR
SET PCENUM=PCENUM+1
SET FLERNG=$PIECE(FILELIST,"|",PCENUM)
if FLERNG']""
QUIT
Begin DoDot:2
+30 SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"F1-FLERNG",FLERNG)=""
+31 ;Set ^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
DO FILNDX(FLERNG,PKGNAME,"FR",.FSET)
End DoDot:2
End DoDot:1
+32 ;
+33 ;*Lowest File # & *Highest File # [2nd priority when defined and File Ranges Not defined]
+34 IF FILELIST=""
Begin DoDot:1
+35 ;Set ^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
IF BEGFLNUM]""
IF ENDFLNUM]""
DO FILNDX(BEGFLNUM_"-"_ENDFLNUM,PKGNAME,"LH",.FSET)
End DoDot:1
+36 ;
+37 ;*File List [3rd priority when defined and File Ranges & *Low/*High not defined]
+38 IF $PIECE(LINEITEM,"^",7)'=""
Begin DoDot:1
+39 SET FILELIST=$PIECE(LINEITEM,"^",7)
+40 SET PCENUM=0
+41 FOR
SET PCENUM=PCENUM+1
SET FNUM=$PIECE(FILELIST,"|",PCENUM)
if FNUM']""
QUIT
Begin DoDot:2
+42 ;Define File Number array nodes
SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"F3-FNUM",FNUM_"-"_FNUM)=""
+43 ;Set ^TMP("XTVS-FRIDX",$J,<file #>,<file #>,<package name>)=""
if 'FSET
DO FILNDX(FNUM_"-"_FNUM,PKGNAME,"FL",FSET)
End DoDot:2
End DoDot:1
+44 ;
+45 ;Define Start/End File number array nodes
+46 IF BEGFLNUM]""
SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"F2-BEGFILE",BEGFLNUM_"-"_ENDFLNUM)=BEGFLNUM
+47 IF ENDFLNUM]""
SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"F2-ENDFILE",BEGFLNUM_"-"_ENDFLNUM)=ENDFLNUM
+48 ;
+49 ;Define Additional & Excepted Prefix Array nodes
+50 SET APFXLST=PKGPFX_"|"_$PIECE(LINEITEM,"^",5)
+51 SET RPFXLST=$PIECE(LINEITEM,"^",6)
+52 SET PCENUM=0
+53 FOR
SET PCENUM=PCENUM+1
SET APFX=($PIECE(APFXLST,"|",PCENUM))
if APFX']""
QUIT
Begin DoDot:1
+54 ;Additional Namespace
SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"ADDPFX",APFX)=""
+55 ;Set ^TMP("XTVS-PFXIDX",$J,,<namespace prefix>,<package name>)="" [Additional & Excepted Prefixe Index]
DO PFXIDX(APFX,PKGNAME,APFXLST_"^"_RPFXLST)
End DoDot:1
+56 ;Set ^TMP("XTVS-PFXIDX",$J,<namespace prefix>,<package name>)="" [Primary Prefix index]
if PKGPFX]""
DO PFXIDX(PKGPFX,PKGNAME,APFXLST_"^"_RPFXLST)
+57 ;
+58 SET PCENUM=0
+59 FOR
SET PCENUM=PCENUM+1
SET RPFX=($PIECE(RPFXLST,"|",PCENUM))
if RPFX']""
QUIT
Begin DoDot:1
+60 ;Excepted Namespace
SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"REMPFX",RPFX)=""
End DoDot:1
+61 ;
+62 ;Define Parent array node
+63 SET ^TMP("XTVS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"PARENT")=$PIECE(LINEITEM,"^",9)
+64 ;
+65 QUIT
+66 ;
+67 ;
+68 ;"XTVS-FRIDX" USAGE NOTE: Supports File Range Overlap report
+69 ; In CHKFILE^XTVSLPR1, loop ^TMP("XTVS-FRIDX,"$J)
+70 ; Retrieve Begin/End Range values for "F1-FLERNG" [Subscripts 3 & 4]
+71 ; Check File Range of checked package for:
+72 ; If RNGEND < "F1-FLERNG" node begin # ...QUIT check
+73 ; If RNGBEG > "F1-FLERNG" node end # ...QUIT check
+74 ;
+75 ; If RNGBEG '< "F1-FLERNG" begin node, check for package name
+76 ; If not package name, create a File overlap error node indicating "F1-FLERNG" package, overlapping files and RNG package
+77 ; If RNGEND '> "F1-FLERNG" end node, check for package name
+78 ; If not package name, create a File overlap error node indicating "F1-FLERNG" package, overlapping files and RNG package
+79 ;
FILNDX(FLRNGE,PKGNAME,TYPE,FSET) ; Set File Number Index [^TMP("XTVS-FRIDX",$J)]
+1 ;Input: FLRNGE - File Range
+2 ; PKGNAME - Package name
+3 ; TYPE - Type of File data
+4 ; FR : File Range multiple
+5 ; LH : *Lowest & *Highest fields
+6 ; FL : File List multiple
+7 ; FSET - File Data set indicator for ^XTMP("XTVS-FRIDX")
+8 ; 0 : Not set
+9 ; 1 : Set
+10 ;
+11 ;Output : File Range Node [^TMP("XTVS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""]
+12 ;
+13 ; <begin file #> and <end file #> are defined from the data in the following order:
+14 ; 1) Package 'File Range' multiple'
+15 ; If Overlap package 'File Range' is not defined, then...
+16 ; 2) Package file range defined by '*Lowest File#' & '*Highest File#'
+17 ;
+18 NEW BEGFNUM,ENDFNUM
+19 SET BEGFNUM=$PIECE(FLRNGE,"-")
+20 SET ENDFNUM=$PIECE(FLRNGE,"-",2)
+21 SET ^TMP("XTVS-FRIDX",$JOB,BEGFNUM,ENDFNUM,PKGNAME)=TYPE
+22 SET FSET=1
+23 QUIT
+24 ;
+25 ;
+26 ;"XTVS-PFXIDX" USAGE NOTE: Supports Prefix Overlap report
+27 ; In CHKPFX^XTVSLPR1, loop ^TMP("XTVS-PFXIDX",$J,<prefix>,<package name>)
+28 ; Extract Primary Prefix (4th subscript) and added Prefixes from "ADDPFX" (6th subscript)
+29 ; If <package name> in Array subscript doesn't equal "package name"...
+30 ; create a Prefix overlap error node indicating "ADDPFX" package, overlapping prefix and "PFXIDX" package [MLTPFX^XTVSLPR1]
+31 ;
PFXIDX(PKGPFX,PKGNAME,PFXLST) ;Set ^TMP("XTVS-PFXIDX",$J,<namespace prefix>,<package name>)=<list of prefixes>
+1 SET PFXLST=$GET(PFXLST)
+2 SET ^TMP("XTVS-PFXIDX",$JOB,PKGPFX,PKGNAME)=PFXLST
+3 QUIT
+4 ;
SCAPARY(LINEITEM) ; Set single line Array & caption display array for action processing
+1 NEW PARMDAT,PKG
+2 ;
+3 ;Set Caption Display Array
+4 SET PKG=$PIECE(LINEITEM,"^")
+5 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG)=LINEITEM
+6 SET PARMDAT=$PIECE(LINEITEM,"^")
+7 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,1,"Package Name")=PARMDAT
+8 SET PARMDAT=$PIECE(LINEITEM,"^",2)
+9 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,2,"Primary Prefix")=PARMDAT
+10 SET PARMDAT=$PIECE(LINEITEM,"^",3)
+11 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,3,"*Lowest File#")=PARMDAT
+12 SET PARMDAT=$PIECE(LINEITEM,"^",4)
+13 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,4,"*Highest File#")=PARMDAT
+14 SET PARMDAT=$PIECE(LINEITEM,"^",5)
+15 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,5,"Additional Prefixes")=PARMDAT
+16 SET PARMDAT=$PIECE(LINEITEM,"^",6)
+17 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,6,"Excepted Prefixes")=PARMDAT
+18 SET PARMDAT=$PIECE(LINEITEM,"^",7)
+19 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,7,"File Numbers")=PARMDAT
+20 SET PARMDAT=$PIECE(LINEITEM,"^",8)
+21 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,8,"File Ranges")=PARMDAT
+22 SET PARMDAT=$PIECE(LINEITEM,"^",9)
+23 SET ^TMP("XTVS-PARAM-CAP",$JOB,PKG,9,"Parent Package")=PARMDAT
+24 QUIT
+25 ;
CLNTMPGB ;Kill temporary globals
+1 KILL ^TMP("XTVS-PKGEDIT",$JOB),^TMP("XTVS-ERROR",$JOB),^TMP("XTVS-FRIDX",$JOB),^TMP("XTVS-PFXIDX",$JOB)
+2 KILL ^TMP("XTVS-PARAM-CAP",$JOB)
+3 QUIT
+4 ;
PRMFLIST(FLESRCH,PAWSOUT) ;List parameter files for selection
+1 NEW DEFDIR,FILENME,FILELIST,LSTRSLT,SELARY,ITEMNUM
+2 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+3 IF $GET(FLESRCH)=""
SET FLESRCH="XTMPSIZE*"
+4 IF $GET(PAWSOUT)=""
SET PAWSOUT=" There are no XTMPSIZE files for comparison!"
+5 SET FILENME(FLESRCH)=""
+6 SET LSTRSLT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
+7 SET FILENME=""
+8 IF LSTRSLT
Begin DoDot:1
+9 ; Move XTMPSIZE files to SELARY
+10 SET ITEMNUM=0
+11 FOR
SET FILENME=$ORDER(FILELIST(FILENME))
if FILENME=""
QUIT
Begin DoDot:2
+12 ;Parameter list
IF (FLESRCH'[".LCK")
IF (FILENME'[".LCK")
SET ITEMNUM=ITEMNUM+1
SET SELARY(ITEMNUM)=FILENME
+13 ; Lock list
IF (FLESRCH[".LCK")
SET ITEMNUM=ITEMNUM+1
SET SELARY(ITEMNUM)=FILENME
End DoDot:2
+14 ;
+15 IF ITEMNUM>0
Begin DoDot:2
+16 ;List Parameter files for selection
DO LISTOUT^XTVSLAPI(.SELARY)
+17 SET XVAL=+$$SELPKG(ITEMNUM,.SELARY)
+18 ;
+19 IF (+$GET(XVAL)>0)&(+$GET(XVAL)<(ITEMNUM+1))
SET FILENME=SELARY(XVAL)
WRITE " ",FILENME
+20 IF ITEMNUM'>0
DO JUSTPAWS^XTVSLAPI(PAWSOUT)
End DoDot:2
End DoDot:1
+21 ;
+22 IF 'LSTRSLT
DO JUSTPAWS^XTVSLAPI(PAWSOUT)
+23 QUIT FILENME
+24 ;
SELPKG(ITEMNUM,SELARY) ; Select Package to Edit from ^TMP("XTVS PKG MGR PARAM CAP",$J)
+1 ; INPUT: SELARY - Array of packages
+2 ; ITEMNUM - Number of items in SELARY
+3 ;
+4 ; OUTPUT: PKGNME - Name of selected package
+5 ;
+6 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+7 SET DIR("A")="Select File: "
+8 SET DIR(0)="NAO^1:"_ITEMNUM_"^K:(X'?.N) X"
+9 SET DIR("?",1)=" Select item # for the desired file from the list."
+10 SET DIR("?")=" [Enter'^' to exit]"
+11 SET DIR("??")="^DO LISTOUT^XTVSLAPI(.SELARY)"
+12 DO ^DIR
+13 QUIT Y
+14 ;
+15 ;
PARMMAP ; Map of Parameter data elements
+1 ;
+2 ;Parameter List data map to Package file (#9.4):
+3 ;-----------------------------------------------
+4 ; ^ pce 1 : Package Name
+5 ; [Source: NAME (#.01)]
+6 ; ^ pce 2 : Primary Prefix
+7 ; [Source: PREFIX (#1)]
+8 ; ^ pce 3 : *Lowest File #
+9 ; [Source: *LOWEST FILE NUMBER (#10.6)]
+10 ; ^ pce 4 : *Highest File #
+11 ; [Source: *HIGHEST FILE NUMBER (#11)]
+12 ; ^ pce 5 : Pipe character (|) delimited list of Additional Prefixes
+13 ; [Source: ADDITIONAL PREFIXES multiple (#14)]
+14 ; ^ pce 6 : Pipe character (|) delimited list of Excepted Prefixes
+15 ; [Source: EXCLUDED NAME SPACE multiple (#919)]
+16 ; ^ pce 7 : Pipe character (|) delimited list of File Number entries
+17 ; [Source: FILE NUMBER multiple (#15001)]
+18 ; ^ pce 8 : Pipe character (|) delimited list of File Range entries
+19 ; [Source: LOW-HIGH RANGE multiple (#15001.1)]
+20 ; ^ pce 9 : Parent Package
+21 ; [Source: PARENT PACKAGE field (#15003)]
+22 ;
+23 ;$END
+24 ;
+25 ;PROTOCOL entry points
+26 ;
PKGERR ; -- Package Parameter Errors
+1 ; -- Protocol: XTVS PKG MGR PARAM ERR DISP ACTION
+2 DO EN^XTVSLPER
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
PARAMRPT ; -- Package Parameter Caption list
+1 ; -- Protocol: XTVS PKG MGR PARAM DISP CAPTION ACTION
+2 NEW LCKCHK
+3 DO EN^XTVSLPDC
+4 SET LCKCHK=$$CHKPID^XTVSLAPI($$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I"),XTVPSPRM)
+5 IF $PIECE(LCKCHK,"^")=1
Begin DoDot:1
+6 DO REFRESH
+7 DO MSG
End DoDot:1
+8 IF $PIECE(LCKCHK,"^")'=1
SET VALMQUIT=""
+9 QUIT
+10 ;
PARAMAP ; -- Display Data Map for Parameter File
+1 ; -- Protocol: XTVS PKG MGR PARAM DATA MAP HELP ACTION
+2 NEW HLPTEXT,LNENUM
+3 DO FULL^VALM1
+4 FOR LNENUM=1:1
SET HLPTEXT=$PIECE($TEXT(PARMMAP+LNENUM),";",2)
if HLPTEXT="$END"
QUIT
WRITE !,HLPTEXT
+5 DO JUSTPAWS^XTVSLAPI
+6 ;
+7 DO REFRESH
+8 DO MSG
+9 QUIT
+10 ;
PARAMCMP ; -- Package Parameter Comparison report
+1 ; -- Protocol: XTVS PKG MGR PARAM COMPARE ACTION
+2 NEW CMPRFNME
+3 DO FULL^VALM1
+4 ;Select a File to compare
SET CMPRFNME=$$PRMFLIST^XTVSLP()
+5 IF CMPRFNME["XTMPSIZE"
Begin DoDot:1
+6 DO EN^XTVSLPC(CMPRFNME)
End DoDot:1
+7 IF CMPRFNME'["XTMPSIZE"
DO JUSTPAWS^XTVSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
+8 DO REFRESH
+9 DO MSG
+10 QUIT
