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

A1VSLPDC.m

Go to the documentation of this file. 
  1. A1VSLPDC ;Albany FO/GTS - VistA Package Sizing Manager - Caption display; 12-JUL-2016
  1.  ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
  1.  ;
  1. EN ; -- main entry point for A1VS PKG MGR PARAM CAPTN DISP
  1.  NEW CHNGMADE
  1.  SET CHNGMADE=0
  1.  D EN^VALM("A1VS PKG MGR PARAM CAPTN DISP")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW DEFDIR,SPCPAD,DIRHEAD,LASTSPKG
  1.  SET SPCPAD=""
  1.  SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
  1.  SET VALMHDR(1)="           VistA Package Size Analysis Manager - Captioned List"
  1.  SET VALMHDR(2)="                     Version: "_$$VERNUM^A1VSLM()_"     Build: "_$$BLDNUM^A1VSLM()
  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: "_A1VPSPRM_$S(+$G(CHNGMADE)>0:"   {EDITED}",1:"")
  1.  SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
  1.  SET VALMHDR(4)=SPCPAD_DIRHEAD
  1.  QUIT
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW DATAITEM,PRMLNLP,PKG,LASTPKG,CAPDAT,LPNM,LNENUM
  1.  DO KILL
  1.  SET PKG=""
  1.  SET VALMCNT=0
  1.  FOR  SET PKG=$O(^TMP("A1VS-PARAM-CAP",$J,PKG)) Q:PKG=""  DO
  1.  . SET LNENUM=0
  1.  . SET CAPDAT=""
  1.  . DO ADD^A1VSLAPI(.VALMCNT," ")
  1.  . DO ADD^A1VSLAPI(.VALMCNT," ")
  1.  . FOR  SET LNENUM=$O(^TMP("A1VS-PARAM-CAP",$J,PKG,LNENUM)) Q:+LNENUM'>0  DO
  1.  .. FOR  SET CAPDAT=$O(^TMP("A1VS-PARAM-CAP",$J,PKG,LNENUM,CAPDAT)) Q:CAPDAT=""  DO
  1.  ... SET DATAITEM=^TMP("A1VS-PARAM-CAP",$J,PKG,LNENUM,CAPDAT)
  1.  ... DO SPLITADD^A1VSLAPI(.VALMCNT,CAPDAT_":  "_DATAITEM)
  1.  QUIT
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  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.  KILL ^TMP("A1VS PKG MGR PARAM CAP",$J) ;,^TMP("A1VS-PARAM-EDIT",$J)
  1.  QUIT
  1.  ;
  1. SELPKG(ADPKG) ; Select Package to Edit from ^TMP("A1VS PKG MGR PARAM CAP",$J)
  1.  ; INPUT:
  1.  ;       ADPKG : 0 - Do not allow add new package [Default]
  1.  ;             : 1 - Allow add new package
  1.  ;
  1.  NEW PKGNME,DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  IF +$G(ADPKG)'=1 SET ADPKG=0  ;Default Add package to 'not allowed"
  1.  SET PKGNME=0
  1.  SET DIR("A")="Select Package: "
  1.  ;SET:ADPKG DIR(0)="FAO^4:40^K:'(X'?1P.E) X"
  1.  ;SET:'ADPKG DIR(0)="FAO^2:40^K:'(X'?1P.E) X"
  1.  SET DIR(0)="FAO^2:40^K:'(X'?1P.E) X"
  1.  SET DIR("PRE")="DO CHKX^A1VSLPDC("_ADPKG_")"
  1.  SET DIR("?")="^DO PKGHLP^A1VSLPDC"
  1.  DO ^DIR
  1.  IF $P(X,"^",1)="+1" SET LASTSPKG=X
  1.  IF '$D(DIRUT) SET PKGNME=Y
  1.  QUIT PKGNME
  1.  ;
  1. DATACHK(PKG) ; Check for existence of entered package in ^TMP("A1VS PKG MGR PARAM CAP",$J)
  1.  NEW RESULT
  1.  SET RESULT=0
  1.  IF $D(^TMP("A1VS-PARAM-CAP",$J,PKG)) SET RESULT=1
  1.  QUIT RESULT
  1.  ;
  1. EDPKGPRM(PKGNME) ; Edit Package Parameters
  1.  NEW CHNGMADE,DATANUM,EDITARY,DATANAME,GETOUT,UPDATLST
  1.  ;SET EDITARY="^TMP(""A1VS-PARAM-EDIT"","_$J_","""_PKGNME_""")"
  1.  SET EDITARY="^TMP(""A1VS-PARAM-CAP"","_$J_","""_PKGNME_""")"
  1.  SET (CHNGMADE,DATANUM)=0
  1.  FOR  SET DATANUM=$O(@EDITARY@(DATANUM)) QUIT:+DATANUM=0  QUIT:($D(DTOUT)!($D(DUOUT)))  DO
  1.  . SET DATANAME=$O(@EDITARY@(DATANUM,""))
  1.  . NEW DIR,X,Y
  1.  . SET DIR("A")=DATANAME_": " ;Set DIR("A") default prompt
  1.  . IF @EDITARY@(DATANUM,DATANAME)]"" SET DIR("B")=@EDITARY@(DATANUM,DATANAME) ;Set Prompt for DIR read
  1.  . ;
  1.  . ;Primary Prefix (2)
  1.  . IF (DATANUM=2) DO
  1.  .. SET DIR("?",1)=" Enter Package Prefix from 2 to 4 characters."
  1.  .. SET DIR("?")="(1 upper case letter followed by 1 - 3 upper case letters or numbers.)"
  1.  .. SET DIR(0)="FA^2:4^K:$L(X)>4!(X'?1U1.3NU) X"
  1.  .. DO ^DIR
  1.  .. IF ('$D(DTOUT)&('$D(DUOUT))) DO
  1.  ... IF ($D(DIRUT)) DO UPDTNODE^A1VSLPD1(DIRUT,EDITARY,DATANUM,DATANAME,X,.CHNGMADE)
  1.  ... IF '$D(DIRUT),(@EDITARY@(DATANUM,DATANAME)'=X) SET @EDITARY@(DATANUM,DATANAME)=Y SET CHNGMADE=1
  1.  ... KILL DIRUT
  1.  . ;
  1.  . ;*Lowest File# (3) & *Highest File# (4)
  1.  . IF ((DATANUM=3)!(DATANUM=4)) DO
  1.  .. SET DIR("?",1)=" Enter File Number 0 - 999999999, decimals allowed."
  1.  .. SET DIR(0)="NOA^0:999999999:6"
  1.  .. DO ^DIR
  1.  .. IF ('$D(DTOUT)&('$D(DUOUT))) DO
  1.  ... IF ($D(DIRUT)) DO UPDTNODE^A1VSLPD1(DIRUT,EDITARY,DATANUM,DATANAME,X,.CHNGMADE)
  1.  ... IF '$D(DIRUT),(@EDITARY@(DATANUM,DATANAME)'=X) SET @EDITARY@(DATANUM,DATANAME)=Y SET CHNGMADE=1
  1.  ... KILL DIRUT
  1.  . ;
  1.  . ;Additional Prefixes (5) & Excepted Prefixes (6)
  1.  . IF ((DATANUM=5)!(DATANUM=6)) DO
  1.  .. NEW LISTDATA  ;,PPRMT
  1.  .. SET GETOUT=0
  1.  .. FOR  QUIT:GETOUT  DO  ;Edit Prefix List Loop
  1.  ... SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
  1.  ... DO SPLITOUT^A1VSLPD1(DATANAME,LISTDATA) ;Display Listed data to screen for user
  1.  ... SET PPRMT="Enter "_$S(DATANUM=5:"Additional",1:"Excepted")_" Prefix: "
  1.  ... SET DIR("A")=PPRMT  ;RESET DIR("A") default prompt
  1.  ... KILL DIR("B") ;No default, select from list
  1.  ... SET DIR("?")=" Enter a new Prefix or one from list. [Note: Entry is case sensitive.]"
  1.  ... SET DIR(0)="FAO^2:6^K:(X'?1U1.5NU) X"
  1.  ... DO ^DIR
  1.  ... IF (Y=-1)!(Y="")!(Y="@")!($D(DTOUT))!($D(DUOUT)) SET GETOUT=1
  1.  ... SET UPDATLST=0
  1.  ... IF 'GETOUT DO EDITPRFX^A1VSLPD1(Y,.LISTDATA,.UPDATLST)
  1.  ... IF UPDATLST SET @EDITARY@(DATANUM,DATANAME)=LISTDATA SET CHNGMADE=1
  1.  . ;
  1.  . ; File Numbers (7)
  1.  . IF (DATANUM=7) DO
  1.  .. NEW LISTDATA
  1.  .. SET GETOUT=0
  1.  .. FOR  QUIT:GETOUT  DO  ;Edit Prefix List Loop
  1.  ... SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
  1.  ... DO SPLITOUT^A1VSLPD1(DATANAME,LISTDATA) ;Display Listed data to screen for user
  1.  ... SET DIR("A")="Enter File Number: " ;RESET DIR("A") default prompt
  1.  ... KILL DIR("B") ;No default, select from list
  1.  ... SET DIR("?",1)=" Enter a new File Number or one from list."
  1.  ... SET DIR("?")="New file numbers only between 1.9999 and 99999999.999999"
  1.  ... SET DIR(0)="NAO^1.9999:99999999.999999:6"
  1.  ... DO ^DIR
  1.  ... IF (Y=-1)!(Y="")!(Y="@")!($D(DTOUT))!($D(DUOUT)) SET GETOUT=1
  1.  ... SET UPDATLST=0
  1.  ... IF 'GETOUT DO EDITFNUM^A1VSLPD1(Y,.LISTDATA,.UPDATLST)
  1.  ... IF UPDATLST SET @EDITARY@(DATANUM,DATANAME)=LISTDATA SET CHNGMADE=1
  1.  . ;
  1.  . ; File Ranges (8)
  1.  . IF (DATANUM=8) DO
  1.  .. NEW LISTDATA
  1.  .. SET GETOUT=0
  1.  .. FOR  QUIT:GETOUT  DO  ;Edit Prefix List Loop
  1.  ... SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
  1.  ... DO SPLITOUT^A1VSLPD1(DATANAME,LISTDATA) ;Display Listed data to screen for user
  1.  ... SET DIR("A")="Enter File Number Range: "  ;RESET DIR("A") default prompt
  1.  ... KILL DIR("B") ;No default, select from list
  1.  ... SET DIR("?",1)=" Enter a new File Number Range or one from the list."
  1.  ... SET DIR("?")="New file number ranges only between 1.9999 and 99999999.999999"
  1.  ... SET DIR(0)="FAO^3:31^K:$$BADRNG^A1VSLPD1(X) X"
  1.  ... DO ^DIR
  1.  ... IF (Y=-1)!(Y="")!(Y="@")!($D(DTOUT))!($D(DUOUT)) SET GETOUT=1
  1.  ... SET UPDATLST=0
  1.  ... IF 'GETOUT DO EDITFRNG^A1VSLPD1(Y,.LISTDATA,.UPDATLST)
  1.  ... IF UPDATLST SET @EDITARY@(DATANUM,DATANAME)=LISTDATA SET CHNGMADE=1
  1.  . ;
  1.  . ;Parent Package (9)
  1.  . IF (DATANUM=9) DO
  1.  .. SET DIR("A",1)=" "
  1.  .. SET DIR("PRE")="DO:X'=""@"" CHKX^A1VSLPDC(0)" ;Check X for existing package
  1.  .. SET DIR("?")="^DO PKGHLP^A1VSLPDC"
  1.  .. SET DIR(0)="FAOr^4:30^K:('(X'?1P.E)) X"
  1.  .. DO ^DIR
  1.  .. IF ('$D(DTOUT)&('$D(DUOUT))) DO
  1.  ... IF ($D(DIRUT)) DO UPDTNODE^A1VSLPD1(DIRUT,EDITARY,DATANUM,DATANAME,X,.CHNGMADE)
  1.  ... IF '$D(DIRUT),(@EDITARY@(DATANUM,DATANAME)'=X) SET @EDITARY@(DATANUM,DATANAME)=Y SET CHNGMADE=1
  1.  . ;
  1.  . KILL DIR,X,Y
  1.  ;
  1.  KILL DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  QUIT CHNGMADE
  1.  ;
  1. CHKX(XADD) ;Check for Package
  1.  ; INPUT:
  1.  ;       XADD : 0 - Do not allow add new package
  1.  ;            : 1 - Allow add new package
  1.  ;
  1.  IF (X="^")!(X']"") QUIT  ;Quit if user entry to exit
  1.  ;
  1.  NEW SELARY,PKGLP,ITEMNUM,XVAL,DOADD
  1.  SET DOADD=0
  1.  IF $G(XADD)']"" SET XADD=0
  1.  IF X=" ",$G(LASTSPKG)]"" SET X=LASTSPKG W X
  1.  IF (X]""),('$D(^TMP("A1VS-PARAM-CAP",$J,X))) DO
  1.  . IF 'XADD DO PKGLIST(.X,.LASTSPKG)
  1.  . IF XADD,$E($G(X),1,1)'="?" DO
  1.  .. IF $L($G(X))>3 DO
  1.  ... SET DOADD=+$$YNCHK^A1VSLAPI("ADD ENTRY")
  1.  ... IF 'DOADD DO PKGLIST(.X,.LASTSPKG)
  1.  .. IF $L($G(X))'>3 DO PKGLIST(.X,.LASTSPKG)
  1.  .. IF DOADD DO
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X)=X ;Create new entry in TMP global
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,1,"Package Name")=X
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,2,"Primary Prefix")=""
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,3,"*Lowest File#")=""
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,4,"*Highest File#")=""
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,5,"Additional Prefixes")=""
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,6,"Excepted Prefixes")=""
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,7,"File Numbers")=""
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,8,"File Ranges")=""
  1.  ... SET ^TMP("A1VS-PARAM-CAP",$J,X,9,"Parent Package")=""
  1.  . IF XADD,$E($G(X),1,1)="?" DO PKGLIST(.X,.LASTSPKG)
  1.  ;
  1.  QUIT
  1.  ;
  1. PKGLIST(X,LASTSPKG) ;List packages from user entry [to support 'XADD' mod in CHKX]
  1.  SET ITEMNUM=0
  1.  SET PKGLP=$G(X)
  1.  FOR  SET PKGLP=$O(^TMP("A1VS-PARAM-CAP",$J,PKGLP))  Q:PKGLP=""  Q:($E(PKGLP,1,$L($G(X)))'=$G(X))  DO
  1.  . SET ITEMNUM=ITEMNUM+1
  1.  . SET SELARY(ITEMNUM)=PKGLP
  1.  IF ITEMNUM>0 DO
  1.  . SET XVAL=0
  1.  . DO LISTOUT^A1VSLAPI(.SELARY) ;List Packages for selection
  1.  . FOR  READ !,"Enter number for Selected Package: ",XVAL:DTIME  Q:'$T  Q:$E(XVAL,1)="^"  Q:XVAL=""  Q:((+XVAL>0)&(+XVAL<(ITEMNUM+1)))  DO
  1.  .. IF XVAL["?" W !,"Select a package.  [Number 1 - "_ITEMNUM_"]"
  1.  .. IF XVAL'?1.3"?" W !,"??"
  1.  .. DO JUSTPAWS^A1VSLAPI(" Select from the listed packages. ['^' to exit]")
  1.  .. DO LISTOUT^A1VSLAPI(.SELARY) ; Relist packages
  1.  . ;
  1.  IF '((+$G(XVAL)>0)&(+$G(XVAL)<(ITEMNUM+1))) KILL X ;If didn't enter existing package or select from a list, require re-entry of package
  1.  IF (+$G(XVAL)>0)&(+$G(XVAL)<(ITEMNUM+1)) SET (LASTSPKG,X)=SELARY(XVAL) W "   ",X
  1.  QUIT
  1.  ;
  1. PKGHLP ; Package selection help
  1.  WRITE !," Select a Package from list of packages. [Package Name is case sensitive.]"
  1.  IF +$$YNCHK^A1VSLAPI("Do you want a list of packages") DO 
  1.  . NEW SELARY,ITEMNUM,PKGLP
  1.  . SET ITEMNUM=0
  1.  . SET PKGLP=""
  1.  . FOR  SET PKGLP=$O(^TMP("A1VS-PARAM-CAP",$J,PKGLP))  Q:PKGLP=""  DO
  1.  .. SET ITEMNUM=ITEMNUM+1
  1.  .. SET SELARY(ITEMNUM)=PKGLP
  1.  . DO LISTOUT^A1VSLAPI(.SELARY) ; Relist packages
  1.  QUIT
  1.  ;
  1. EDITPRM ; Edit parameters for a package
  1.  ; -- Protocol: A1VS PKG MGR EDIT PACKAGE PARM ACTION
  1.  ;
  1.  ;Logic notes:
  1.  ; Select package name
  1.  ; Create EDIT version of "A1VS-PARAM-CAP" array ["A1VS-PARAM-EDIT"]
  1.  ; Execute DIR to prompt data in selected package
  1.  ; Update ^TMP("A1VS-PARAM-CAP") array from "A1VS-PARAM-EDIT" array
  1.  ; Redisplay all 'Edited' packages to screen, set "Edit" param to allow Write Edited pkgs action
  1.  ; [Need an action to write "edited" packages]
  1.  ;    [. Walk through ^TMP("A1VS-PARAM-CAP",$J,<package name>) nodes @ write to file named in "A1VPSPRM" variable]
  1.  ;
  1.  NEW PKGNME,EDITARY,CAPARY
  1.  DO FULL^VALM1
  1.  SET PKGNME=$$SELPKG(1)
  1.  IF PKGNME'=0 DO
  1.  . SET CAPARY="^TMP(""A1VS-PARAM-CAP"","_$J_","""_PKGNME_""")"
  1.  . SET CHNGMADE=$$EDPKGPRM(PKGNME)
  1.  . IF CHNGMADE DO  ;MERGE @CAPARY=@EDITARY DO 
  1.  .. SET @CAPARY=$$SETSTR^A1VSLPD1(CAPARY)
  1.  .. DO HDR,INIT
  1.  ;
  1.  IF PKGNME=0 DO JUSTPAWS^A1VSLAPI(" Existing Package Not Selected.")
  1.  ;
  1.  SET VALMBCK="R"
  1.  QUIT
  1.  ;
  1. DELPMPKG ; Delete parameters from a package
  1.  ; -- Protocol: A1VS PKG MGR DEL PACKAGE PARM ACTION
  1.  ;
  1.  NEW PKGNME,CAPARY
  1.  DO FULL^VALM1
  1.  SET PKGNME=$$SELPKG(0)
  1.  IF PKGNME'=0 DO
  1.  . SET CAPARY="^TMP(""A1VS-PARAM-CAP"","_$J_","""_PKGNME_""")"
  1.  . WRITE !,"You have chosen to delete the "_PKGNME_" entry"
  1.  . WRITE !," from the "_A1VPSPRM_" Package Parameter file.",!
  1.  . WRITE !,"[If deleted, "_PKGNME_" will not be included"
  1.  . WRITE !,"  in the VistA Size Report!]",!
  1.  . SET CHNGMADE=+$$YNCHK^A1VSLAPI("Are you SURE you want to delete the parameters for this package")
  1.  . IF CHNGMADE KILL @CAPARY DO HDR,INIT
  1.  ;
  1.  IF PKGNME=0 DO JUSTPAWS^A1VSLAPI(" Existing Package Not Selected.")
  1.  ;
  1.  SET VALMBCK="R"
  1.  QUIT
  1.  ;
  1. SAVPMPKG ; Save Package Parameters file
  1.  ; -- Protocol: A1VS PKG MGR SAVE PACKAGE PARM ACTION
  1.  ;
  1.  DO FULL^VALM1
  1.  IF +$G(CHNGMADE)'>0 DO JUSTPAWS^A1VSLAPI("No Edits have been made.  Nothing new to save!")
  1.  IF +$G(CHNGMADE)>0 DO
  1.  . NEW POPERR,NOWDT,INITIAL,PKGNME,WNFILE,WOFILE,FILENME,DEFDIR
  1.  . SET POPERR=0
  1.  . SET NOWDT=$$FMTE^XLFDT($$NOW^XLFDT,"2M")
  1.  . SET NOWDT=$TR(NOWDT,"/","-")
  1.  . SET NOWDT=$TR(NOWDT,"@","_")
  1.  . SET NOWDT=$TR(NOWDT,":","")
  1.  . SET INITIAL=$P($G(^VA(200,DUZ,0)),"^",2)
  1.  . IF INITIAL']"" SET INITIAL="<unk>"
  1.  . SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
  1.  . ;
  1.  . SET (WNFILE,WOFILE)=0
  1.  . SET WNFILE=+$$YNCHK^A1VSLAPI("Do you want to create a new package parameters file")
  1.  . SET:'WNFILE WOFILE=+$$YNCHK^A1VSLAPI("Do you want to OVERWRITE the existing package parameters file")
  1.  . IF (WNFILE)!(WOFILE) DO
  1.  .. NEW DELRSLT
  1.  .. IF WNFILE SET FILENME="XTMPSIZE"_"_"_INITIAL_NOWDT_".DAT" ;Output a New Parameter file
  1.  .. ;
  1.  .. SET DELRSLT=1 ; Initialize DELRSLT (delete Result) variable
  1.  .. IF WOFILE DO  ;FILENME remains the selected/displayed parameter file
  1.  ... NEW DELFLE,OLDFNME
  1.  ... SET FILENME=A1VPSPRM
  1.  ... IF FILENME[";" SET FILENME=$P(FILENME,";")
  1.  ... SET OLDFNME=$P(FILENME,".")_".BAK"
  1.  ... SET DELFLE(OLDFNME)="" SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NA(DELFLE)) K DELFLE(OLDFNME) ;Delete current Parameter file
  1.  ... SET DELRSLT=$$MV^%ZISH(DEFDIR,A1VPSPRM,DEFDIR,OLDFNME) ;Save current file to "OLD" before overwriting
  1.  ... IF DELRSLT SET DELFLE(A1VPSPRM)="" SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NA(DELFLE)) ;Delete current Parameter file
  1.  ... SET FILENME=A1VPSPRM
  1.  .. ;
  1.  .. ; If file name definitions and copies were completed successfully, create the Parameter file
  1.  .. IF DELRSLT DO
  1.  ... DO OPEN^%ZISH("XTMP",DEFDIR,FILENME,"A")
  1.  ... SET:POP POPERR=POP
  1.  ... QUIT:POPERR
  1.  ... U IO
  1.  ... SET PKGNME=""
  1.  ... FOR  SET PKGNME=$O(^TMP("A1VS-PARAM-CAP",$J,PKGNME)) QUIT:PKGNME']""  WRITE !,^TMP("A1VS-PARAM-CAP",$J,PKGNME)
  1.  ... D CLOSE^%ZISH("XTMP")
  1.  ... SET A1VPSPRM=FILENME
  1.  ... SET CHNGMADE=0
  1.  ... DO HDR,INIT
  1.  ;
  1.  SET VALMBCK="R"
  1.  QUIT