A1VSLP ;Albany FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
EN ; -- main entry point for A1VS PKG MGR PARAM DISPLAY
D EN^VALM("A1VS PKG MGR PARAM DISPLAY")
Q
;
HDR ; -- header code
NEW DEFDIR,SPCPAD,DIRHEAD
SET SPCPAD=""
SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Parameter Display"
SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
SET DIRHEAD="Default Directory: "_DEFDIR
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(3)=SPCPAD_DIRHEAD
SET SPCPAD=""
SET DIRHEAD="Parameter file: "_A1VPSPRM
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(4)=SPCPAD_DIRHEAD
QUIT
;
BUILD ; - Build local and global display arrays
NEW DEFDIR,CAPNODE
DO KILL ;Kill all processing & data arrays and video attributes & control arrays
SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
DO OPEN^%ZISH("XTMP",DEFDIR,A1VPSPRM,"R")
U IO
SET (CAPNODE,VALMCNT)=0
FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
. IF LINEITEM]"" DO
.. DO SCAPARY(LINEITEM,.CAPNODE) ;Creates ^TMP("A1VS-PARAM-CAP",$J) array
.. DO SPLITADD^A1VSLAPI(.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 A1TMPLNN
. SET A1TMPLNN=$$SELXTMP^A1VSLAPI(FIRSTITM,LASTITM,5)
. IF +A1TMPLNN>0 DO
.. SET A1VPSPRM=$P($G(^TMP("A1VS PACKAGE MGR",$J,A1TMPLNN,0)),A1TMPLNN-5_") ",2)
.. IF A1VPSPRM]"" DO BUILD
.. IF A1VPSPRM']"" SET VALMQUIT=""
. IF A1TMPLNN=-1 DO EXIT^A1VSLP S VALMQUIT=""
QUIT
;
HELP ; -- help code
SET X="?" D DISP^XQORM1
;SET VALMBCK="R"
Q
;
EXIT ; -- exit code
DO KILL
Q
;
EXPND ; -- expand code
Q
;
REFRESH ; -- refresh display
DO BUILD
SET VALMBCK="R"
QUIT
;
MSG(TEXT) ; -- set default message
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("A1VS PKG MAN PARM DISP",$JOB)
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
;APIs ;TO DO: GTS - Further develop these APIs so LINEITEM is the most current/edited package parameter data
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}","BEGINFILE")=file number [Start file #]
; ^TMP("{package name}","{primary prefix}","ENDFILE")=file number [Ending file #]
; ^TMP("{package name}","{primary prefix}","FNUM",{file#})="" [File # from FILE NUMBER multiple]
; ^TMP("{package name}","{primary prefix}","FLERNG","{file range 1}")="" [File # range from LOW-HIGH RANGE multiple]
; ^TMP("{package name}","{primary prefix}","PARENT")=Package [PARENT PACKAGE field]
; ^TMP("{package name}","{primary prefix}","REMPFX","{removed prefix}")=""
;
;IF +$G(CLEANONE)'>0 SET CLEANONE=0
SET PKGNAME=$P(LINEITEM,"^")
SET PKGPFX=$P(LINEITEM,"^",2)
;
;Load package components into ^TMP Global (loop)
SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX)=LINEITEM ;Define Data node
;
;Define File Range array nodes
SET FILELIST=$P(LINEITEM,"^",8)
SET PCENUM=0
IF FILELIST'="" DO
. FOR SET PCENUM=PCENUM+1 SET FLERNG=$P(FILELIST,"|",PCENUM) QUIT:FLERNG']"" DO
.. SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"FLERNG",FLERNG)=""
.. DO FILNDX(FLERNG,PKGNAME) ;Set ^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
IF FILELIST="" DO
. NEW BEG,END
. SET BEG=$P(LINEITEM,"^",3)
. SET END=$P(LINEITEM,"^",4)
. IF BEG]"",END]"" DO FILNDX(BEG_"-"_END,PKGNAME) ;Set ^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
;
;Define Start/End File number array nodes
SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"BEGFILE")=$P(LINEITEM,"^",3)
SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"ENDFILE")=$P(LINEITEM,"^",4)
;
;Define File Number array nodes
SET FILELIST=$P(LINEITEM,"^",7)
SET PCENUM=0
FOR SET PCENUM=PCENUM+1 SET FNUM=$P(FILELIST,"|",PCENUM) QUIT:FNUM']"" DO
. SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"FNUM",FNUM)=""
;
;Define Additional & Excepted Prefix Array nodes
SET APFXLST=$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("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"ADDPFX",APFX)="" ;Additional Namespace
. DO PFXIDX(APFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("A1VS-PFXIDX",$J,,<namespace prefix>,<package name>)=""
DO:PKGPFX]"" PFXIDX(PKGPFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("A1VS-PFXIDX",$J,<namespace prefix>,<package name>)="" [Primary Prefix]
;
SET PCENUM=0
FOR SET PCENUM=PCENUM+1 SET RPFX=($P(RPFXLST,"|",PCENUM)) QUIT:RPFX']"" DO
. SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"REMPFX",RPFX)="" ;Excepted Namespace
;
;Define Parent array node
SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"PARENT")=$P(LINEITEM,"^",9)
;
QUIT
;
;
;"A1VS-FRIDX" USAGE NOTE: Extract file range subscript from "FLERNG" nodes one-by-one
; Retrieve Begin/End Range values from "FLERNG"
; @QSUBSCRIPT "FRIDX" nodes retrieving Begin File #
; if RNGEND < "FLERNG" node begin...QUIT check
; if RNGBEG > "FLERNG" node end...QUIT check
;
; If RNGBEG '< "FLERNG" begin node, check for package name
; if not package name, create a File overlap error node indicating "FLERNG" package, overlapping files and RNG package
; If RNGEND '> "FLERNG" end node, check for package name
; if not package name, create a File overlap error node indicating "FLERNG" package, overlapping files and RNG package
;
FILNDX(FLRNGE,PKGNAME) ; Set File Number Index [^TMP("A1VS-FRIDX",$J)]
;Input: FLRNGE - File Range
; PKGNAME - Package name
;
;Output : File Range Node [^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""]
;
NEW BEGFNUM,ENDFNUM
SET BEGFNUM=$P(FLRNGE,"-")
SET ENDFNUM=$P(FLRNGE,"-",2)
SET ^TMP("A1VS-FRIDX",$J,BEGFNUM,ENDFNUM,PKGNAME)=""
QUIT
;
;
;"A1VS-PFXIDX" USAGE NOTE: Loop ^TMP("A1VS-PKGEDIT",$J,<pkg name>,<prefix>)
; Place <prefix> in a local prefix array
; Extract Primary Prefix (4th subscript) and added Prefixes from "ADDPFX" (6th subscript) one-by-one and pass to CHKPRX
; Loop ^TMP("A1VS-PFXIDX",$J,<prefix>,<package name>)
; If <package name> in Array subscript doesn't equal "package name"...
; create a File overlap error node indicating "ADDPFX" package, overlapping prefix and "PFXIDX" package
;
PFXIDX(PKGPFX,PKGNAME,PFXLST) ;Set ^TMP("A1VS-PKGEDIT",$J,"PFXIDX",<namespace prefix>,<package name>)=""
SET PFXLST=$G(PFXLST)
SET ^TMP("A1VS-PFXIDX",$J,PKGPFX,PKGNAME)=PFXLST
QUIT
;
SCAPARY(LINEITEM,CAPNODE) ; Set single line Array & caption display array for action processing
NEW PARMDAT,PKG
SET CAPNODE=CAPNODE+1
;SET ^TMP("A1VS-PARAM-LINE",$J,CAPNODE)=LINEITEM ; Set Parameter LineItem array
;
;Set Caption Display Array
SET PKG=$P(LINEITEM,"^")
SET ^TMP("A1VS-PARAM-CAP",$J,PKG)=LINEITEM
SET PARMDAT=$P(LINEITEM,"^")
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,1,"Package Name")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",2)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,2,"Primary Prefix")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",3)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,3,"*Lowest File#")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",4)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,4,"*Highest File#")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",5)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,5,"Additional Prefixes")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",6)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,6,"Excepted Prefixes")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",7)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,7,"File Numbers")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",8)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,8,"File Ranges")=PARMDAT
SET PARMDAT=$P(LINEITEM,"^",9)
SET ^TMP("A1VS-PARAM-CAP",$J,PKG,9,"Parent Package")=PARMDAT
QUIT
;
CLNTMPGB ;Kill temporary globals
KILL ^TMP("A1VS-PKGEDIT",$J),^TMP("A1VS-ERROR",$J),^TMP("A1VS-FRIDX",$J),^TMP("A1VS-PFXIDX",$J)
KILL ^TMP("A1VS-PARAM-CAP",$J) ;,^TMP("A1VS-PARAM-LINE",$J)
QUIT
;
PRMFLIST() ;List parameter files for selection
NEW DEFDIR,FILENME,FILELIST,LSTRSLT,SELARY,ITEMNUM
SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
SET FILENME("XTMPSIZE*")=""
SET LSTRSLT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
IF LSTRSLT DO
.; Move XTMPSIZE files to SELARY
.SET ITEMNUM=0
.SET FILENME=""
.FOR SET FILENME=$O(FILELIST(FILENME)) Q:FILENME="" SET ITEMNUM=ITEMNUM+1 SET SELARY(ITEMNUM)=FILENME
.;
.IF ITEMNUM>1 DO
.. DO LISTOUT^A1VSLAPI(.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'>1 DO JUSTPAWS^A1VSLAPI(" There are no XTMPSIZE files for comparison!")
QUIT FILENME
;
SELPKG(ITEMNUM,SELARY) ; Select Package to Edit from ^TMP("A1VS 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 ;,PKGNME
;SET PKGNME=""
SET DIR("A")="Select File: "
SET DIR(0)="NAO^1:"_ITEMNUM_"^K:(X'?.N) X"
;SET DIR("PRE")="K:'$D(SELARY("_+$G(X)_")) X"
SET DIR("?",1)=" Select item # for the desired parameter file from the list."
SET DIR("?")=" [Enter'^' to exit]"
SET DIR("??")="^DO LISTOUT^A1VSLAPI(.SELARY)"
DO ^DIR
;IF $P(X,"^",1)="+1" SET LASTSPKG=X
;;IF '$D(DIRUT) SET PKGNME=SELARY(Y)
QUIT Y
;
;
PARMMAP ; Map of Parameter data elements
;
;Parameter List data map from Package file:
;------------------------------------------
; ^ 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 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: A1VS PKG MGR PARAM ERR DISP ACTION
DO EN^A1VSLPER
DO REFRESH
DO MSG
QUIT
;
PARAMRPT ; -- Package Parameter Caption list
; -- Protocol: A1VS PKG MGR PARAM DISP CAPTION ACTION
DO EN^A1VSLPDC
DO REFRESH
DO MSG
QUIT
;
PARAMAP ; -- Display Data Map for Parameter File
; -- Protocol: A1VS 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^A1VSLAPI
;
DO REFRESH
DO MSG
QUIT
;
PARAMCMP ; -- Package Parameter Comparison report
; -- Protocol: A1VS PKG MGR PARAM COMPARE ACTION
NEW CMPRFNME
DO FULL^VALM1
SET CMPRFNME=$$PRMFLIST^A1VSLP() ;Select a File to compare
IF CMPRFNME["XTMPSIZE" DO
. DO EN^A1VSLPC(CMPRFNME)
IF CMPRFNME'["XTMPSIZE" DO JUSTPAWS^A1VSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
DO REFRESH
DO MSG
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1VSLP 12070 printed Sep 23, 2025@19:14:42 Page 2
A1VSLP ;Albany FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
+1 ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
EN ; -- main entry point for A1VS PKG MGR PARAM DISPLAY
+1 DO EN^VALM("A1VS PKG MGR PARAM DISPLAY")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW DEFDIR,SPCPAD,DIRHEAD
+2 SET SPCPAD=""
+3 SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Parameter Display"
+5 SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
+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: "_A1VPSPRM
+11 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+12 SET VALMHDR(4)=SPCPAD_DIRHEAD
+13 QUIT
+14 ;
BUILD ; - Build local and global display arrays
+1 NEW DEFDIR,CAPNODE
+2 ;Kill all processing & data arrays and video attributes & control arrays
DO KILL
+3 SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+4 DO OPEN^%ZISH("XTMP",DEFDIR,A1VPSPRM,"R")
+5 USE IO
+6 SET (CAPNODE,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("A1VS-PARAM-CAP",$J) array
DO SCAPARY(LINEITEM,.CAPNODE)
+10 DO SPLITADD^A1VSLAPI(.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 A1TMPLNN
+3 SET A1TMPLNN=$$SELXTMP^A1VSLAPI(FIRSTITM,LASTITM,5)
+4 IF +A1TMPLNN>0
Begin DoDot:2
+5 SET A1VPSPRM=$PIECE($GET(^TMP("A1VS PACKAGE MGR",$JOB,A1TMPLNN,0)),A1TMPLNN-5_") ",2)
+6 IF A1VPSPRM]""
DO BUILD
+7 IF A1VPSPRM']""
SET VALMQUIT=""
End DoDot:2
+8 IF A1TMPLNN=-1
DO EXIT^A1VSLP
SET VALMQUIT=""
End DoDot:1
+9 QUIT
+10 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
+2 ;SET VALMBCK="R"
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
REFRESH ; -- refresh display
+1 DO BUILD
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
MSG(TEXT) ; -- set default message
+1 QUIT
+2 ;
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("A1VS PKG MAN PARM DISP",$JOB)
+5 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+6 QUIT
+7 ;
+8 ;APIs ;TO DO: GTS - Further develop these APIs so LINEITEM is the most current/edited package parameter data
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}","BEGINFILE")=file number [Start file #]
+7 ; ^TMP("{package name}","{primary prefix}","ENDFILE")=file number [Ending file #]
+8 ; ^TMP("{package name}","{primary prefix}","FNUM",{file#})="" [File # from FILE NUMBER multiple]
+9 ; ^TMP("{package name}","{primary prefix}","FLERNG","{file range 1}")="" [File # range from LOW-HIGH RANGE multiple]
+10 ; ^TMP("{package name}","{primary prefix}","PARENT")=Package [PARENT PACKAGE field]
+11 ; ^TMP("{package name}","{primary prefix}","REMPFX","{removed prefix}")=""
+12 ;
+13 ;IF +$G(CLEANONE)'>0 SET CLEANONE=0
+14 SET PKGNAME=$PIECE(LINEITEM,"^")
+15 SET PKGPFX=$PIECE(LINEITEM,"^",2)
+16 ;
+17 ;Load package components into ^TMP Global (loop)
+18 ;Define Data node
SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX)=LINEITEM
+19 ;
+20 ;Define File Range array nodes
+21 SET FILELIST=$PIECE(LINEITEM,"^",8)
+22 SET PCENUM=0
+23 IF FILELIST'=""
Begin DoDot:1
+24 FOR
SET PCENUM=PCENUM+1
SET FLERNG=$PIECE(FILELIST,"|",PCENUM)
if FLERNG']""
QUIT
Begin DoDot:2
+25 SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"FLERNG",FLERNG)=""
+26 ;Set ^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
DO FILNDX(FLERNG,PKGNAME)
End DoDot:2
End DoDot:1
+27 IF FILELIST=""
Begin DoDot:1
+28 NEW BEG,END
+29 SET BEG=$PIECE(LINEITEM,"^",3)
+30 SET END=$PIECE(LINEITEM,"^",4)
+31 ;Set ^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
IF BEG]""
IF END]""
DO FILNDX(BEG_"-"_END,PKGNAME)
End DoDot:1
+32 ;
+33 ;Define Start/End File number array nodes
+34 SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"BEGFILE")=$PIECE(LINEITEM,"^",3)
+35 SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"ENDFILE")=$PIECE(LINEITEM,"^",4)
+36 ;
+37 ;Define File Number array nodes
+38 SET FILELIST=$PIECE(LINEITEM,"^",7)
+39 SET PCENUM=0
+40 FOR
SET PCENUM=PCENUM+1
SET FNUM=$PIECE(FILELIST,"|",PCENUM)
if FNUM']""
QUIT
Begin DoDot:1
+41 SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"FNUM",FNUM)=""
End DoDot:1
+42 ;
+43 ;Define Additional & Excepted Prefix Array nodes
+44 SET APFXLST=$PIECE(LINEITEM,"^",5)
+45 SET RPFXLST=$PIECE(LINEITEM,"^",6)
+46 SET PCENUM=0
+47 FOR
SET PCENUM=PCENUM+1
SET APFX=($PIECE(APFXLST,"|",PCENUM))
if APFX']""
QUIT
Begin DoDot:1
+48 ;Additional Namespace
SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"ADDPFX",APFX)=""
+49 ;Set ^TMP("A1VS-PFXIDX",$J,,<namespace prefix>,<package name>)=""
DO PFXIDX(APFX,PKGNAME,APFXLST_"^"_RPFXLST)
End DoDot:1
+50 ;Set ^TMP("A1VS-PFXIDX",$J,<namespace prefix>,<package name>)="" [Primary Prefix]
if PKGPFX]""
DO PFXIDX(PKGPFX,PKGNAME,APFXLST_"^"_RPFXLST)
+51 ;
+52 SET PCENUM=0
+53 FOR
SET PCENUM=PCENUM+1
SET RPFX=($PIECE(RPFXLST,"|",PCENUM))
if RPFX']""
QUIT
Begin DoDot:1
+54 ;Excepted Namespace
SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"REMPFX",RPFX)=""
End DoDot:1
+55 ;
+56 ;Define Parent array node
+57 SET ^TMP("A1VS-PKGEDIT",$JOB,PKGNAME,PKGPFX,"PARENT")=$PIECE(LINEITEM,"^",9)
+58 ;
+59 QUIT
+60 ;
+61 ;
+62 ;"A1VS-FRIDX" USAGE NOTE: Extract file range subscript from "FLERNG" nodes one-by-one
+63 ; Retrieve Begin/End Range values from "FLERNG"
+64 ; @QSUBSCRIPT "FRIDX" nodes retrieving Begin File #
+65 ; if RNGEND < "FLERNG" node begin...QUIT check
+66 ; if RNGBEG > "FLERNG" node end...QUIT check
+67 ;
+68 ; If RNGBEG '< "FLERNG" begin node, check for package name
+69 ; if not package name, create a File overlap error node indicating "FLERNG" package, overlapping files and RNG package
+70 ; If RNGEND '> "FLERNG" end node, check for package name
+71 ; if not package name, create a File overlap error node indicating "FLERNG" package, overlapping files and RNG package
+72 ;
FILNDX(FLRNGE,PKGNAME) ; Set File Number Index [^TMP("A1VS-FRIDX",$J)]
+1 ;Input: FLRNGE - File Range
+2 ; PKGNAME - Package name
+3 ;
+4 ;Output : File Range Node [^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""]
+5 ;
+6 NEW BEGFNUM,ENDFNUM
+7 SET BEGFNUM=$PIECE(FLRNGE,"-")
+8 SET ENDFNUM=$PIECE(FLRNGE,"-",2)
+9 SET ^TMP("A1VS-FRIDX",$JOB,BEGFNUM,ENDFNUM,PKGNAME)=""
+10 QUIT
+11 ;
+12 ;
+13 ;"A1VS-PFXIDX" USAGE NOTE: Loop ^TMP("A1VS-PKGEDIT",$J,<pkg name>,<prefix>)
+14 ; Place <prefix> in a local prefix array
+15 ; Extract Primary Prefix (4th subscript) and added Prefixes from "ADDPFX" (6th subscript) one-by-one and pass to CHKPRX
+16 ; Loop ^TMP("A1VS-PFXIDX",$J,<prefix>,<package name>)
+17 ; If <package name> in Array subscript doesn't equal "package name"...
+18 ; create a File overlap error node indicating "ADDPFX" package, overlapping prefix and "PFXIDX" package
+19 ;
PFXIDX(PKGPFX,PKGNAME,PFXLST) ;Set ^TMP("A1VS-PKGEDIT",$J,"PFXIDX",<namespace prefix>,<package name>)=""
+1 SET PFXLST=$GET(PFXLST)
+2 SET ^TMP("A1VS-PFXIDX",$JOB,PKGPFX,PKGNAME)=PFXLST
+3 QUIT
+4 ;
SCAPARY(LINEITEM,CAPNODE) ; Set single line Array & caption display array for action processing
+1 NEW PARMDAT,PKG
+2 SET CAPNODE=CAPNODE+1
+3 ;SET ^TMP("A1VS-PARAM-LINE",$J,CAPNODE)=LINEITEM ; Set Parameter LineItem array
+4 ;
+5 ;Set Caption Display Array
+6 SET PKG=$PIECE(LINEITEM,"^")
+7 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG)=LINEITEM
+8 SET PARMDAT=$PIECE(LINEITEM,"^")
+9 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,1,"Package Name")=PARMDAT
+10 SET PARMDAT=$PIECE(LINEITEM,"^",2)
+11 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,2,"Primary Prefix")=PARMDAT
+12 SET PARMDAT=$PIECE(LINEITEM,"^",3)
+13 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,3,"*Lowest File#")=PARMDAT
+14 SET PARMDAT=$PIECE(LINEITEM,"^",4)
+15 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,4,"*Highest File#")=PARMDAT
+16 SET PARMDAT=$PIECE(LINEITEM,"^",5)
+17 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,5,"Additional Prefixes")=PARMDAT
+18 SET PARMDAT=$PIECE(LINEITEM,"^",6)
+19 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,6,"Excepted Prefixes")=PARMDAT
+20 SET PARMDAT=$PIECE(LINEITEM,"^",7)
+21 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,7,"File Numbers")=PARMDAT
+22 SET PARMDAT=$PIECE(LINEITEM,"^",8)
+23 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,8,"File Ranges")=PARMDAT
+24 SET PARMDAT=$PIECE(LINEITEM,"^",9)
+25 SET ^TMP("A1VS-PARAM-CAP",$JOB,PKG,9,"Parent Package")=PARMDAT
+26 QUIT
+27 ;
CLNTMPGB ;Kill temporary globals
+1 KILL ^TMP("A1VS-PKGEDIT",$JOB),^TMP("A1VS-ERROR",$JOB),^TMP("A1VS-FRIDX",$JOB),^TMP("A1VS-PFXIDX",$JOB)
+2 ;,^TMP("A1VS-PARAM-LINE",$J)
KILL ^TMP("A1VS-PARAM-CAP",$JOB)
+3 QUIT
+4 ;
PRMFLIST() ;List parameter files for selection
+1 NEW DEFDIR,FILENME,FILELIST,LSTRSLT,SELARY,ITEMNUM
+2 SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+3 SET FILENME("XTMPSIZE*")=""
+4 SET LSTRSLT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
+5 IF LSTRSLT
Begin DoDot:1
+6 ; Move XTMPSIZE files to SELARY
+7 SET ITEMNUM=0
+8 SET FILENME=""
+9 FOR
SET FILENME=$ORDER(FILELIST(FILENME))
if FILENME=""
QUIT
SET ITEMNUM=ITEMNUM+1
SET SELARY(ITEMNUM)=FILENME
+10 ;
+11 IF ITEMNUM>1
Begin DoDot:2
+12 ;List Parameter files for selection
DO LISTOUT^A1VSLAPI(.SELARY)
+13 SET XVAL=+$$SELPKG(ITEMNUM,.SELARY)
+14 ;
+15 IF (+$GET(XVAL)>0)&(+$GET(XVAL)<(ITEMNUM+1))
SET FILENME=SELARY(XVAL)
WRITE " ",FILENME
End DoDot:2
End DoDot:1
+16 ;
+17 IF ITEMNUM'>1
DO JUSTPAWS^A1VSLAPI(" There are no XTMPSIZE files for comparison!")
+18 QUIT FILENME
+19 ;
SELPKG(ITEMNUM,SELARY) ; Select Package to Edit from ^TMP("A1VS 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 ;,PKGNME
NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+7 ;SET PKGNME=""
+8 SET DIR("A")="Select File: "
+9 SET DIR(0)="NAO^1:"_ITEMNUM_"^K:(X'?.N) X"
+10 ;SET DIR("PRE")="K:'$D(SELARY("_+$G(X)_")) X"
+11 SET DIR("?",1)=" Select item # for the desired parameter file from the list."
+12 SET DIR("?")=" [Enter'^' to exit]"
+13 SET DIR("??")="^DO LISTOUT^A1VSLAPI(.SELARY)"
+14 DO ^DIR
+15 ;IF $P(X,"^",1)="+1" SET LASTSPKG=X
+16 ;;IF '$D(DIRUT) SET PKGNME=SELARY(Y)
+17 QUIT Y
+18 ;
+19 ;
PARMMAP ; Map of Parameter data elements
+1 ;
+2 ;Parameter List data map from Package file:
+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 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: A1VS PKG MGR PARAM ERR DISP ACTION
+2 DO EN^A1VSLPER
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
PARAMRPT ; -- Package Parameter Caption list
+1 ; -- Protocol: A1VS PKG MGR PARAM DISP CAPTION ACTION
+2 DO EN^A1VSLPDC
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
PARAMAP ; -- Display Data Map for Parameter File
+1 ; -- Protocol: A1VS 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^A1VSLAPI
+6 ;
+7 DO REFRESH
+8 DO MSG
+9 QUIT
+10 ;
PARAMCMP ; -- Package Parameter Comparison report
+1 ; -- Protocol: A1VS PKG MGR PARAM COMPARE ACTION
+2 NEW CMPRFNME
+3 DO FULL^VALM1
+4 ;Select a File to compare
SET CMPRFNME=$$PRMFLIST^A1VSLP()
+5 IF CMPRFNME["XTMPSIZE"
Begin DoDot:1
+6 DO EN^A1VSLPC(CMPRFNME)
End DoDot:1
+7 IF CMPRFNME'["XTMPSIZE"
DO JUSTPAWS^A1VSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
+8 DO REFRESH
+9 DO MSG
+10 QUIT
