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

A1VSLP.m

Go to the documentation of this file. 
  1. A1VSLP ;Albany FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
  1.  ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
  1. EN ; -- main entry point for A1VS PKG MGR PARAM DISPLAY
  1.  D EN^VALM("A1VS 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","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
  1.  SET VALMHDR(1)="           VistA Package Size Analysis Manager - Parameter Display"
  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
  1.  SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
  1.  SET VALMHDR(4)=SPCPAD_DIRHEAD
  1.  QUIT
  1.  ;
  1. BUILD ; - Build local and global display arrays
  1.  NEW DEFDIR,CAPNODE
  1.  DO KILL ;Kill all processing & data arrays and video attributes & control arrays
  1.  SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
  1.  DO OPEN^%ZISH("XTMP",DEFDIR,A1VPSPRM,"R")
  1.  U IO
  1.  SET (CAPNODE,VALMCNT)=0
  1.  FOR  S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH  DO
  1.  . IF LINEITEM]"" DO 
  1.  .. DO SCAPARY(LINEITEM,.CAPNODE) ;Creates ^TMP("A1VS-PARAM-CAP",$J) array
  1.  .. DO SPLITADD^A1VSLAPI(.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.  IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO
  1.  . NEW A1TMPLNN
  1.  . SET A1TMPLNN=$$SELXTMP^A1VSLAPI(FIRSTITM,LASTITM,5)
  1.  . IF +A1TMPLNN>0 DO
  1.  .. SET A1VPSPRM=$P($G(^TMP("A1VS PACKAGE MGR",$J,A1TMPLNN,0)),A1TMPLNN-5_") ",2)
  1.  .. IF A1VPSPRM]"" DO BUILD
  1.  .. IF A1VPSPRM']"" SET VALMQUIT=""
  1.  . IF A1TMPLNN=-1 DO EXIT^A1VSLP S VALMQUIT=""
  1.  QUIT
  1.  ;
  1. HELP ; -- help code
  1.  SET X="?" D DISP^XQORM1
  1.  ;SET VALMBCK="R"
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  DO KILL
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. REFRESH ; -- refresh display
  1.  DO BUILD
  1.  SET VALMBCK="R"
  1.  QUIT
  1.  ;
  1. MSG(TEXT) ; -- set default message
  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("A1VS PKG MAN PARM DISP",$JOB)
  1.  KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
  1.  QUIT
  1.  ;
  1.  ;APIs ;TO DO: GTS - Further develop these APIs so LINEITEM is the most current/edited package parameter data
  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}","BEGINFILE")=file number [Start file #]
  1.  ;  ^TMP("{package name}","{primary prefix}","ENDFILE")=file number [Ending file #]
  1.  ;  ^TMP("{package name}","{primary prefix}","FNUM",{file#})="" [File # from FILE NUMBER multiple]
  1.  ;  ^TMP("{package name}","{primary prefix}","FLERNG","{file range 1}")="" [File # range from LOW-HIGH RANGE multiple]
  1.  ;  ^TMP("{package name}","{primary prefix}","PARENT")=Package [PARENT PACKAGE field]
  1.  ;  ^TMP("{package name}","{primary prefix}","REMPFX","{removed prefix}")=""
  1.  ;
  1.  ;IF +$G(CLEANONE)'>0 SET CLEANONE=0
  1.  SET PKGNAME=$P(LINEITEM,"^")
  1.  SET PKGPFX=$P(LINEITEM,"^",2)
  1.  ;
  1.  ;Load package components into ^TMP Global (loop)
  1.  SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX)=LINEITEM ;Define Data node
  1.  ;
  1.  ;Define File Range array nodes
  1.  SET FILELIST=$P(LINEITEM,"^",8)
  1.  SET PCENUM=0
  1.  IF FILELIST'="" DO
  1.  . FOR  SET PCENUM=PCENUM+1 SET FLERNG=$P(FILELIST,"|",PCENUM) QUIT:FLERNG']""  DO
  1.  .. SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"FLERNG",FLERNG)=""
  1.  .. DO FILNDX(FLERNG,PKGNAME) ;Set ^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
  1.  IF FILELIST="" DO 
  1.  . NEW BEG,END
  1.  . SET BEG=$P(LINEITEM,"^",3)
  1.  . SET END=$P(LINEITEM,"^",4)
  1.  . IF BEG]"",END]"" DO FILNDX(BEG_"-"_END,PKGNAME) ;Set ^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""
  1.  ;
  1.  ;Define Start/End File number array nodes
  1.  SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"BEGFILE")=$P(LINEITEM,"^",3)
  1.  SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"ENDFILE")=$P(LINEITEM,"^",4)
  1.  ;
  1.  ;Define File Number array nodes
  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("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"FNUM",FNUM)=""
  1.  ;
  1.  ;Define Additional & Excepted Prefix Array nodes
  1.  SET APFXLST=$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("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"ADDPFX",APFX)="" ;Additional Namespace
  1.  . DO PFXIDX(APFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("A1VS-PFXIDX",$J,,<namespace prefix>,<package name>)=""
  1.  DO:PKGPFX]"" PFXIDX(PKGPFX,PKGNAME,APFXLST_"^"_RPFXLST) ;Set ^TMP("A1VS-PFXIDX",$J,<namespace prefix>,<package name>)="" [Primary Prefix]
  1.  ;
  1.  SET PCENUM=0
  1.  FOR  SET PCENUM=PCENUM+1 SET RPFX=($P(RPFXLST,"|",PCENUM)) QUIT:RPFX']""  DO
  1.  . SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"REMPFX",RPFX)="" ;Excepted Namespace
  1.  ;
  1.  ;Define Parent array node
  1.  SET ^TMP("A1VS-PKGEDIT",$J,PKGNAME,PKGPFX,"PARENT")=$P(LINEITEM,"^",9)
  1.  ;
  1.  QUIT
  1.  ;
  1.  ;
  1.  ;"A1VS-FRIDX" USAGE NOTE: Extract file range subscript from "FLERNG" nodes one-by-one
  1.  ; Retrieve Begin/End Range values from "FLERNG"
  1.  ; @QSUBSCRIPT "FRIDX" nodes retrieving Begin File #
  1.  ; if RNGEND < "FLERNG" node begin...QUIT check
  1.  ; if RNGBEG > "FLERNG" node end...QUIT check
  1.  ;
  1.  ; If RNGBEG '< "FLERNG" begin node, check for package name
  1.  ;  if not package name, create a File overlap error node indicating "FLERNG" package, overlapping files and RNG package
  1.  ; If RNGEND '> "FLERNG" end node, check for package name
  1.  ;  if not package name, create a File overlap error node indicating "FLERNG" package, overlapping files and RNG package
  1.  ;
  1. FILNDX(FLRNGE,PKGNAME) ; Set File Number Index [^TMP("A1VS-FRIDX",$J)]
  1.  ;Input: FLRNGE  - File Range
  1.  ;       PKGNAME - Package name
  1.  ;
  1.  ;Output : File Range Node [^TMP("A1VS-FRIDX",$J,<begin file #>,<end file #>,<package name>)=""]
  1.  ;
  1.  NEW BEGFNUM,ENDFNUM
  1.  SET BEGFNUM=$P(FLRNGE,"-")
  1.  SET ENDFNUM=$P(FLRNGE,"-",2)
  1.  SET ^TMP("A1VS-FRIDX",$J,BEGFNUM,ENDFNUM,PKGNAME)=""
  1.  QUIT
  1.  ;
  1.  ;
  1.  ;"A1VS-PFXIDX" USAGE NOTE: Loop ^TMP("A1VS-PKGEDIT",$J,<pkg name>,<prefix>)
  1.  ; Place <prefix> in a local prefix array
  1.  ; Extract Primary Prefix (4th subscript) and added Prefixes from "ADDPFX" (6th subscript) one-by-one and pass to CHKPRX
  1.  ; Loop ^TMP("A1VS-PFXIDX",$J,<prefix>,<package name>)
  1.  ; If <package name> in Array subscript doesn't equal "package name"...
  1.  ;   create a File overlap error node indicating "ADDPFX" package, overlapping prefix and "PFXIDX" package
  1.  ;
  1. PFXIDX(PKGPFX,PKGNAME,PFXLST) ;Set ^TMP("A1VS-PKGEDIT",$J,"PFXIDX",<namespace prefix>,<package name>)=""
  1.  SET PFXLST=$G(PFXLST)
  1.  SET ^TMP("A1VS-PFXIDX",$J,PKGPFX,PKGNAME)=PFXLST
  1.  QUIT
  1.  ;
  1. SCAPARY(LINEITEM,CAPNODE) ; Set single line Array & caption display array for action processing
  1.  NEW PARMDAT,PKG
  1.  SET CAPNODE=CAPNODE+1
  1.  ;SET ^TMP("A1VS-PARAM-LINE",$J,CAPNODE)=LINEITEM ; Set Parameter LineItem array
  1.  ;
  1.  ;Set Caption Display Array
  1.  SET PKG=$P(LINEITEM,"^")
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG)=LINEITEM
  1.  SET PARMDAT=$P(LINEITEM,"^")
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,1,"Package Name")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",2)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,2,"Primary Prefix")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",3)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,3,"*Lowest File#")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",4)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,4,"*Highest File#")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",5)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,5,"Additional Prefixes")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",6)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,6,"Excepted Prefixes")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",7)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,7,"File Numbers")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",8)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,8,"File Ranges")=PARMDAT
  1.  SET PARMDAT=$P(LINEITEM,"^",9)
  1.  SET ^TMP("A1VS-PARAM-CAP",$J,PKG,9,"Parent Package")=PARMDAT
  1.  QUIT
  1.  ;
  1. CLNTMPGB ;Kill temporary globals
  1.  KILL ^TMP("A1VS-PKGEDIT",$J),^TMP("A1VS-ERROR",$J),^TMP("A1VS-FRIDX",$J),^TMP("A1VS-PFXIDX",$J)
  1.  KILL ^TMP("A1VS-PARAM-CAP",$J) ;,^TMP("A1VS-PARAM-LINE",$J)
  1.  QUIT
  1.  ;
  1. PRMFLIST() ;List parameter files for selection
  1.  NEW DEFDIR,FILENME,FILELIST,LSTRSLT,SELARY,ITEMNUM
  1.  SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
  1.  SET FILENME("XTMPSIZE*")=""
  1.  SET LSTRSLT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
  1.  IF LSTRSLT DO
  1.  .; Move XTMPSIZE files to SELARY
  1.  .SET ITEMNUM=0
  1.  .SET FILENME=""
  1.  .FOR  SET FILENME=$O(FILELIST(FILENME)) Q:FILENME=""  SET ITEMNUM=ITEMNUM+1 SET SELARY(ITEMNUM)=FILENME
  1.  .;
  1.  .IF ITEMNUM>1 DO 
  1.  .. DO LISTOUT^A1VSLAPI(.SELARY) ;List Parameter files for selection
  1.  .. SET XVAL=+$$SELPKG(ITEMNUM,.SELARY)
  1.  .. ;
  1.  ..IF (+$G(XVAL)>0)&(+$G(XVAL)<(ITEMNUM+1)) SET FILENME=SELARY(XVAL) W "   ",FILENME
  1.  ;
  1.  IF ITEMNUM'>1 DO JUSTPAWS^A1VSLAPI(" There are no XTMPSIZE files for comparison!")
  1.  QUIT FILENME
  1.  ;
  1. SELPKG(ITEMNUM,SELARY) ; Select Package to Edit from ^TMP("A1VS PKG MGR PARAM CAP",$J)
  1.  ; INPUT: SELARY  - Array of packages
  1.  ;        ITEMNUM - Number of items in SELARY
  1.  ;
  1.  ; OUTPUT: PKGNME - Name of selected package
  1.  ;       
  1.  NEW DIR,DIRUT,DTOUT,DUOUT,X,Y ;,PKGNME
  1.  ;SET PKGNME=""
  1.  SET DIR("A")="Select File: "
  1.  SET DIR(0)="NAO^1:"_ITEMNUM_"^K:(X'?.N) X"
  1.  ;SET DIR("PRE")="K:'$D(SELARY("_+$G(X)_")) X"
  1.  SET DIR("?",1)=" Select item # for the desired parameter file from the list."
  1.  SET DIR("?")="   [Enter'^' to exit]"
  1.  SET DIR("??")="^DO LISTOUT^A1VSLAPI(.SELARY)"
  1.  DO ^DIR
  1.  ;IF $P(X,"^",1)="+1" SET LASTSPKG=X
  1.  ;;IF '$D(DIRUT) SET PKGNME=SELARY(Y)
  1.  QUIT Y
  1.  ;
  1.  ;
  1. PARMMAP ; Map of Parameter data elements
  1.  ; 
  1.  ;Parameter List data map from Package file:
  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 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: A1VS PKG MGR PARAM ERR DISP ACTION 
  1.  DO EN^A1VSLPER
  1.  DO REFRESH
  1.  DO MSG
  1.  QUIT
  1.  ;
  1. PARAMRPT ; -- Package Parameter Caption list
  1.  ; -- Protocol: A1VS PKG MGR PARAM DISP CAPTION ACTION
  1.  DO EN^A1VSLPDC
  1.  DO REFRESH
  1.  DO MSG
  1.  QUIT
  1.  ;
  1. PARAMAP ; -- Display Data Map for Parameter File
  1.  ; -- Protocol: A1VS 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^A1VSLAPI
  1.  ;
  1.  DO REFRESH
  1.  DO MSG
  1.  QUIT
  1.  ;
  1. PARAMCMP ; -- Package Parameter Comparison report
  1.  ; -- Protocol: A1VS PKG MGR PARAM COMPARE ACTION
  1.  NEW CMPRFNME
  1.  DO FULL^VALM1
  1.  SET CMPRFNME=$$PRMFLIST^A1VSLP() ;Select a File to compare
  1.  IF CMPRFNME["XTMPSIZE" DO
  1.  . DO EN^A1VSLPC(CMPRFNME)
  1.  IF CMPRFNME'["XTMPSIZE" DO JUSTPAWS^A1VSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
  1.  DO REFRESH
  1.  DO MSG
  1.  QUIT