XTVSLPD2 ;ALBANY FO/GTS - VistA Package Sizing Manager - Caption display APIs; 14-DEC-2018
;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
;Per VA Directive 6402, this routine should not be modified.
;
;APIs 2
PRIMPFX(XTA,XTB,XTJUMPIN) ; Enter/Edit Primary Prefix
IF $G(XTJUMPIN) NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
NEW ADDPKG
;Package Added Indicator = 1 when Primary Primary Prefix XTVS-PARAM-CAP ^TMP global node is Null
SET ADDPKG=((^TMP("XTVS-PARAM-CAP",$J,PKGNME,DATANUM,"Primary Prefix")=""))
SET DIR("A")=XTA
SET:XTB]"" DIR("B")=XTB
SET DIR("?",1)="Enter Package Prefix from 2 to 4 characters."
SET DIR("?",2)=" (1 upper case letter followed by 1 - 3 upper case letters or numbers.)"
SET DIR("?",3)=" "
SET DIR("?",4)="Prefixes are used to identify Routines, Options, Protocols, etc. for the"
SET DIR("?")=" VistA Package Size report."
SET DIR(0)="FA^2:4^K:$L(X)>4!(X'?1U1.3NU) X"
DO ^DIR
IF ('$D(DTOUT)&('$D(DUOUT))) DO
. IF ($D(DIRUT)) DO UPDTNODE(DIRUT,EDITARY,DATANUM,DATANAME,X)
. IF '$D(DIRUT),(@EDITARY@(DATANUM,DATANAME)'=X) SET @EDITARY@(DATANUM,DATANAME)=Y
. KILL DIRUT
IF ($D(DTOUT)!$D(DUOUT)!$D(DIROUT))&((ADDPKG)&(X="^")) DO
. KILL ^TMP("XTVS-PARAM-CAP",$J,PKGNME)
. DO HDR^XTVSLPDC,INIT^XTVSLPDC
. SET DATANUM=999 ;Do not prompt other fields
IF $D(DUOUT),(X["^"),($L(X)>1) DO
. IF ADDPKG DO
.. DO JUSTPAWS^XTVSLAPI(" Data Entry '^' JUMP not allowed before Primary Prefix is defined.")
.. W !
.. SET DATANUM=1
.. KILL DUOUT
. IF 'ADDPKG DO JUMP(X,DATANUM) SET DATANUM=DATANUM-1
QUIT
;
HILOFLE(XTA,XTB,XTJUMPIN) ; Enter/Edit High or Low File Number
IF $G(XTJUMPIN) NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
SET DIR("A")=XTA
SET:XTB]"" DIR("B")=XTB
SET DIR("?",1)=" Enter File Number 0 - 999999999, decimals are allowed."
SET DIR("?",2)=" "
SET DIR("?",3)=" When File Ranges are undefined and *Lowest File# & *Highest File# are"
SET DIR("?",4)=" defined, *Lowest File# - *Highest File# range is used to identify files"
SET DIR("?")=" assigned to the package for the VistA Package Size report."
SET DIR(0)="NOA^0:999999999:6"
DO ^DIR
IF ('$D(DTOUT)&('$D(DUOUT))) DO
. IF ($D(DIRUT)) DO UPDTNODE(DIRUT,EDITARY,DATANUM,DATANAME,X)
. IF '$D(DIRUT),(@EDITARY@(DATANUM,DATANAME)'=X) SET @EDITARY@(DATANUM,DATANAME)=Y
. KILL DIRUT
IF $D(DUOUT),(X["^") DO JUMP(X,DATANUM) SET DATANUM=DATANUM-1
QUIT
;
EXADPFX(XTA,XTB,XTJUMPIN) ; Enter/Edit Excepted or Additional Prefixes
NEW LISTDATA,PPRMT
IF $G(XTJUMPIN) NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
SET DIR("A")=XTA
SET:XTB]"" DIR("B")=XTB
SET GETOUT=0
FOR QUIT:GETOUT DO ;Edit Prefix List Loop
. SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
. DO SPLITOUT(DATANAME,LISTDATA) ;Display Listed data to screen for user
. SET PPRMT="Enter "_$S(DATANUM=5:"Additional",1:"Excepted")_" Prefix: "
. SET DIR("A")=PPRMT ;RESET DIR("A") default prompt
. KILL DIR("B") ;No default, select from list
. SET DIR("?",1)="Enter a new Prefix or one from list. [Note: Entry is case sensitive.]"
. SET DIR("?",2)="Order of Prefixes listed is not significant."
. SET DIR("?",3)=" "
. SET DIR("?",4)="Additional and Excepted Prefixes are used to identify Routines, Options,"
. SET DIR("?",5)=" Protocols, etc. for the VistA Package Size reporting tool. Additional"
. SET DIR("?",6)=" Prefixes include components [that begin with the prefix] in the tally"
. SET DIR("?",7)=" totals for the component. Excepted Prefixes are refinements to the"
. SET DIR("?",8)=" Primary and Additional Prefixes to exclude subsets of component names"
. SET DIR("?")=" [that begin with the Excepted Prefixes] from the tally totals."
. SET DIR(0)="FAO^2:6^K:(X'?1U1.5NU) X"
. DO ^DIR
. IF (Y=-1)!(Y="")!(Y="@")!($D(DTOUT))!($D(DUOUT)) SET GETOUT=1
. SET UPDATLST=0
. IF 'GETOUT DO EDITPRFX(Y,.LISTDATA,.UPDATLST)
. IF GETOUT,$D(DUOUT),(X["^") DO JUMP(X,DATANUM) SET DATANUM=DATANUM-1
. IF UPDATLST SET @EDITARY@(DATANUM,DATANAME)=LISTDATA
QUIT
;
EDITPRFX(DATELEMT,LISTDATA,UPDATLST) ; Update Prefix list
NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,EDTELEMT,PCE
SET PCE=0
IF (LISTDATA["|"_DATELEMT_"|")!($P(LISTDATA,"|")=DATELEMT) SET PCE=$$PCEPOS(LISTDATA,DATELEMT)
SET DIR("A")=" Prefix: "
SET DIR("B")=DATELEMT
SET DIR("?")=" Enter/Edit a Prefix."
SET DIR(0)="FAO^2:6^K:(X'?1U1.5NU) X"
DO ^DIR
IF '$D(DTOUT)&'$D(DUOUT)&'$D(DIROUT) DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
QUIT
;
LSTEDT(EDTELEMT,PCE,DATELEMT,LISTDATA,UPDATLST) ;Edit List dialog
IF (PCE>0),(EDTELEMT'="@") SET $P(LISTDATA,"|",PCE)=EDTELEMT SET UPDATLST=1 ;EDIT ENTRY
IF (PCE>0),(EDTELEMT="@") DO
. IF +$$YNCHK^XTVSLAPI("DELETE ENTRY") SET LISTDATA=$P(LISTDATA,DATELEMT_"|",1)_$P(LISTDATA,DATELEMT_"|",2) SET UPDATLST=1
IF PCE'>0 DO
. IF EDTELEMT="@" W !,"?? ...Element not in list, cannot delete!" SET EDTELEMT=DATELEMT
. IF +$$YNCHK^XTVSLAPI("ADD ENTRY") SET LISTDATA=LISTDATA_EDTELEMT_"|" SET UPDATLST=1
QUIT
;
FLENUM(XTA,XTB,XTJUMPIN) ; Enter/Edit File number
NEW LISTDATA
IF $G(XTJUMPIN) NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
SET DIR("A")=XTA
SET:XTB]"" DIR("B")=XTB
SET GETOUT=0
FOR QUIT:GETOUT DO ;Edit Prefix List Loop
. SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
. DO SPLITOUT(DATANAME,LISTDATA) ;Display Listed data to screen for user
. SET DIR("A")="Enter File Number: " ;RESET DIR("A") default prompt
. KILL DIR("B") ;No default, select from list
. SET DIR("?",1)="Enter a new File Number or one from the list."
. SET DIR("?",2)="New file numbers only between 1.9999 and 99999999.999999"
. SET DIR("?",3)="Order of File Numbers listed is not significant."
. SET DIR("?",4)=" "
. SET DIR("?",5)="When File Ranges and *Lowest File# & *Highest File# are undefined and"
. SET DIR("?",6)=" File Numbers exist, File Numbers are used to identify files assigned"
. SET DIR("?")=" to the package for the VistA Package Size report."
. SET DIR(0)="NAO^1.9999:99999999.999999:6"
. DO ^DIR
. IF (Y=-1)!(Y="")!(Y="@")!($D(DTOUT))!($D(DUOUT)) SET GETOUT=1
. SET UPDATLST=0
. IF 'GETOUT DO EDITFNUM(Y,.LISTDATA,.UPDATLST)
. IF GETOUT,$D(DUOUT),(X["^") DO JUMP(X,DATANUM) SET DATANUM=DATANUM-1
. IF UPDATLST SET @EDITARY@(DATANUM,DATANAME)=LISTDATA
QUIT
;
EDITFNUM(DATELEMT,LISTDATA,UPDATLST) ; Update File list
NEW DIR,DIRUT,DTOUT,DUOUT,EDTELEMT,PCE
SET PCE=0
IF (LISTDATA["|"_DATELEMT_"|")!($P(LISTDATA,"|")=DATELEMT) SET PCE=$$PCEPOS(LISTDATA,DATELEMT)
SET DIR("A")=" File Number: "
SET DIR("B")=DATELEMT
SET DIR("?")=" Enter/Edit a File Number."
SET DIR(0)="NAO^1.9999:99999999.999999:6"
DO ^DIR
IF '$D(DTOUT)&'$D(DUOUT)&'$D(DIROUT) DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
QUIT
;
FLERNG(XTA,XTB,XTJUMPIN) ; Enter/Edit File Range
NEW LISTDATA
IF $G(XTJUMPIN) NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
SET DIR("A")=XTA
SET:XTB]"" DIR("B")=XTB
SET GETOUT=0
FOR QUIT:GETOUT DO ;Edit Prefix List Loop
. SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
. DO SPLITOUT(DATANAME,LISTDATA) ;Display Listed data to screen for user
. SET DIR("A")="Enter File Number Range: " ;RESET DIR("A") default prompt
. KILL DIR("B") ;No default, select from list
. SET DIR("?",1)="Enter a new File Number Range or one from the list."
. SET DIR("?",2)="New file number ranges only between 1.9999 and 99999999.999999"
. SET DIR("?",3)="Order of File Ranges listed is not significant."
. SET DIR("?",4)="Example of a file range would be 500-501.9 with no spaces."
. SET DIR("?",5)=" "
. SET DIR("?",6)="If File Ranges are defined, they are used to identify files assigned to"
. SET DIR("?",7)=" the package whether or not *Lowest File# & *Highest File# or File"
. SET DIR("?")=" Numbers are defined."
. SET DIR(0)="FAO^3:31^K:$$BADRNG^XTVSLPD1(X) X"
. DO ^DIR
. IF (Y=-1)!(Y="")!(Y="@")!($D(DTOUT))!($D(DUOUT)) SET GETOUT=1
. SET UPDATLST=0
. IF 'GETOUT DO EDITFRNG(Y,.LISTDATA,.UPDATLST)
. IF GETOUT,$D(DUOUT),(X["^") DO JUMP(X,DATANUM) SET DATANUM=DATANUM-1
. IF UPDATLST SET @EDITARY@(DATANUM,DATANAME)=LISTDATA
QUIT
;
EDITFRNG(DATELEMT,LISTDATA,UPDATLST) ; Update File Range
NEW DIR,DIRUT,DTOUT,DUOUT,EDTELEMT,PCE
SET PCE=0
IF (LISTDATA["|"_DATELEMT_"|")!($P(LISTDATA,"|")=DATELEMT) SET PCE=$$PCEPOS(LISTDATA,DATELEMT)
SET DIR("A")=" File Number Range: "
SET DIR("B")=DATELEMT
SET DIR("?",1)=" Enter a new File Number Range or one from the list."
SET DIR("?")="New file number ranges only between 1.9999 and 99999999.999999"
SET DIR(0)="FAO^3:31^K:$$BADRNG^XTVSLPD1(X) X"
DO ^DIR
IF '$D(DTOUT)&'$D(DUOUT)&'$D(DIROUT) DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
QUIT
;
PRNTPKG(XTA,XTB,XTJUMPIN) ; Enter/edit Parent Package
IF $G(XTJUMPIN) NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
;
NEW ITEMNUM,SELARY
SET ITEMNUM=$$SETSELAY^XTVSLPDC(.SELARY)
;
SET DIR("A")=XTA
SET:XTB]"" DIR("B")=XTB
SET DIR("A",1)=" "
SET DIR("PRE")="D PRECHK^XTVSLPD2(.X,.LASTSPKG,.SELARY,.ITEMNUM)"
SET DIR("?")="^DO PKGHLP^XTVSLPD2(ITEMNUM)"
SET DIR("??")="^DO LISTOUT^XTVSLAPI(.SELARY)"
SET DIR(0)="FAOr^1:50^K:((X'?.ANP)&(X'?1.4N)) X"
DO ^DIR
;
IF ($D(X))&('$D(DTOUT)&('$D(DUOUT))) DO
. IF ($D(DIRUT)) DO UPDTNODE(DIRUT,EDITARY,DATANUM,DATANAME,X)
. IF '$D(DIRUT),(@EDITARY@(DATANUM,DATANAME)'=X) SET @EDITARY@(DATANUM,DATANAME)=X
IF $D(DUOUT),($G(X)["^") DO JUMP(X,DATANUM) SET DATANUM=DATANUM-1
QUIT
;
JUMP(XVAL,XTOLDNUM) ; Jump to a data element during edit
NEW DTELMT,CT,SUBRTN,XTDONE,DATANAME,DIR,DATANUM,XTFOUND
SET (XTFOUND,XTDONE)=0
IF (XVAL?1"^"0.1"*"1.A0.1" "1.A0.1"#"),(XVAL'="^") DO
. SET XVAL=$$UP^XLFSTR($P(XVAL,"^",2))
. IF (XTOLDNUM'=7),(XTOLDNUM'=8),($$CKMATCH(XVAL,"FILE ")) S DTELMT=$$FLESEL() DO:DTELMT]"" JUMPEXC SET XTDONE=1
. FOR CT=2:1 SET DTELMT=$TEXT(DATANAME+CT) QUIT:$P(DTELMT," ;;",2)="QUIT" QUIT:XTDONE DO
.. IF ($P($P(DTELMT," ;;",2),"^")[XVAL),($$CKMATCH(XVAL,$P($P(DTELMT," ;;",2),"^"))),($P($P(DTELMT," ;;",2),"^",2)'=XTOLDNUM) DO
... DO JUMPEXC
... SET XTDONE=1
. IF 'XTFOUND W " ??" KILL DUOUT,X
. IF XTFOUND W !," Return to "_$P($P($TEXT(DATANAME+XTOLDNUM)," ;;",2),"^",1)_"..."
QUIT
;
JUMPEXC ;Jump to selected field [from JUMP api]
SET XTFOUND=1
SET DATANUM=$P($P(DTELMT," ;;",2),"^",2)
SET DATANAME=$O(@EDITARY@(DATANUM,""))
SET DIR("A")=DATANAME_": " ;Set DIR("A") prompt
SET DIR("B")=$G(@EDITARY@(DATANUM,DATANAME)) ;Set Prompt for DIR read
DO @$P($P(DTELMT," ;;",2),"^",3)
KILL DUOUT
QUIT
;
CKMATCH(XTIN,XTDATNM) ; Check for sub-string match to data element name
NEW RESULT
SET RESULT=(XTIN=$E(XTDATNM,1,$L(XTIN)))
QUIT RESULT
;
FLESEL() ; Select FILE data element for JUMP
NEW RESULT,DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
SET RESULT=""
SET DIR("A")=" Data Element Number: "
SET DIR("?")=" Enter number 1 or 2."
SET DIR("A",1)=" "
SET DIR("A",2)=" Select Data Element:"
SET DIR("A",3)=" 1) File Numbers"
SET DIR("A",4)=" 2) File Ranges"
;SET DIR("A",5)=" "
SET DIR(0)="NA^1:2"
DO ^DIR
IF '$D(DIRUT) SET RESULT=$TEXT(DATANAME+(6+Y))
QUIT RESULT
;
UPDTNODE(UPDIRUT,EDITARY,DATANUM,DATANAME,UPDX) ;Update ^TMP("XTVS-PARAM-CAP") array node with edits
IF ('$D(UPDIRUT)) SET @EDITARY@(DATANUM,DATANAME)=UPDX
IF $D(UPDIRUT) DO
. IF (UPDX="@"),(@EDITARY@(DATANUM,DATANAME)'="") DO
.. IF +$$YNCHK^XTVSLAPI("DELETE ENTRY") SET @EDITARY@(DATANUM,DATANAME)=""
. IF (UPDX'="@"),(@EDITARY@(DATANUM,DATANAME)'=UPDX) SET @EDITARY@(DATANUM,DATANAME)=UPDX
QUIT
;
SPLITOUT(DATANAME,LISTDATA) ; -- Split list data to separate lines as needed and output
; DATANAME - Data element name
; LISTDATA - Data element list
;
NEW LINE,PCENUM,LISTPCE,NXSTPCE
WRITE !!!,DATANAME_":"
IF LISTDATA']"" W !,"{no data list}"
IF LISTDATA]"" DO
. IF $L(LISTDATA)'>79 W !,LISTDATA
. IF $L(LISTDATA)>79 DO
.. SET LINE=""
.. SET NXSTPCE=1
.. FOR PCENUM=1:1 SET LISTPCE=$P(LISTDATA,"|",PCENUM) Q:LISTPCE="" DO
... IF $L($P(LISTDATA,"|",NXSTPCE,PCENUM))>79 W !,$P(LISTDATA,"|",NXSTPCE,PCENUM-1) SET NXSTPCE=PCENUM
.. W !,$P(LISTDATA,"|",NXSTPCE,999)
WRITE !
QUIT
;
PCEPOS(LISTDATA,DATELEMT) ; Return the piece position number of DATELEMT in LISTDATA
NEW PCE,DELIMPOS,ITEM
FOR PCE=1:1 SET ITEM=$P(LISTDATA,"|",PCE) Q:ITEM=DATELEMT IF ITEM="" SET PCE=0 QUIT
QUIT PCE
;
PRECHK(X,LASTSPKG,SELARY,ITEMNUM) ; PRNTPKG X value DIR("PRE") pre-check
IF (X=" "),($G(LASTSPKG)]"") SET X=LASTSPKG W " ",X
IF (X'="@"),(X'["^"),($E(X,1)'["?") DO CHKX^XTVSLPD2(.X,.SELARY,.ITEMNUM)
QUIT
;
CHKX(X,SELARY,ITEMNUM) ;Check X for Package [called by PRECHK via DIR("PRE") in PRNTPKG]
IF X'?.N DO
. NEW PARAMSTR
. SET PARAMSTR("ADDITM")=0 ;No adding items
. SET PARAMSTR("XTUPCASE")=0 ; Case matters
. SET PARAMSTR("PATRN")=".ANP"
. SET PARAMSTR("MINLNG")=4
. SET PARAMSTR("MAXLNG")=50
. SET SELARY=""
. ;
. SET PARAMSTR("ITEMNUM")=ITEMNUM
. DO SELLIST^XTVSLPR2(.SELARY,.ITEMNUM,.X,.PARAMSTR)
;
IF $D(X),(X?.N),(X>ITEMNUM) KILL X
IF $D(X),(+$G(X)>0) SET (LASTSPKG,X)=SELARY(X) W " ",X
;
QUIT
;
PKGHLP(ITEMUM) ; Parent Package selection help
WRITE !,"Enter the name or number (1-"_ITEMNUM_") of the desired Parent Package."
WRITE !," Package Name is case sensitive."
WRITE !," Enter '??' for a numbered list of items OR '^' to exit.",!
WRITE !,"Parent Package indicates an association with a package that may include"
WRITE !," component intersections causing duplicate counting of Routines, Options,"
WRITE !," Protocols, Files, etc. by the VistA Package Size report. For the VistA"
WRITE !," Package Size Analysis Management tools, it is informational."
WRITE !," However for VistA development management teams, it can mean more.",!
QUIT
;
DATANAME ; Package Parameter data element names
;;PACKAGE NAME^1^PKGNME(DIR("A"),DIR("B"),1);;<place holder if Package name becomes editable>
;;PRIMARY PREFIX^2^PRIMPFX(DIR("A"),DIR("B"),1)
;;*LOWEST FILE#^3^HILOFLE(DIR("A"),DIR("B"),1)
;;*HIGHEST FILE#^4^HILOFLE(DIR("A"),DIR("B"),1)
;;ADDITIONAL PREFIXES^5^EXADPFX(DIR("A"),DIR("B"),1)
;;EXCEPTED PREFIXES^6^EXADPFX(DIR("A"),DIR("B"),1)
;;FILE NUMBERS^7^FLENUM(DIR("A"),DIR("B"),1)
;;FILE RANGES^8^FLERNG(DIR("A"),DIR("B"),1)
;;PARENT PACKAGE^9^PRNTPKG(DIR("A"),DIR("B"),1)
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLPD2 14324 printed Jan 18, 2025@03:43:21 Page 2
XTVSLPD2 ;ALBANY FO/GTS - VistA Package Sizing Manager - Caption display APIs; 14-DEC-2018
+1 ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;APIs 2
PRIMPFX(XTA,XTB,XTJUMPIN) ; Enter/Edit Primary Prefix
+1 IF $GET(XTJUMPIN)
NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
+2 NEW ADDPKG
+3 ;Package Added Indicator = 1 when Primary Primary Prefix XTVS-PARAM-CAP ^TMP global node is Null
+4 SET ADDPKG=((^TMP("XTVS-PARAM-CAP",$JOB,PKGNME,DATANUM,"Primary Prefix")=""))
+5 SET DIR("A")=XTA
+6 if XTB]""
SET DIR("B")=XTB
+7 SET DIR("?",1)="Enter Package Prefix from 2 to 4 characters."
+8 SET DIR("?",2)=" (1 upper case letter followed by 1 - 3 upper case letters or numbers.)"
+9 SET DIR("?",3)=" "
+10 SET DIR("?",4)="Prefixes are used to identify Routines, Options, Protocols, etc. for the"
+11 SET DIR("?")=" VistA Package Size report."
+12 SET DIR(0)="FA^2:4^K:$L(X)>4!(X'?1U1.3NU) X"
+13 DO ^DIR
+14 IF ('$DATA(DTOUT)&('$DATA(DUOUT)))
Begin DoDot:1
+15 IF ($DATA(DIRUT))
DO UPDTNODE(DIRUT,EDITARY,DATANUM,DATANAME,X)
+16 IF '$DATA(DIRUT)
IF (@EDITARY@(DATANUM,DATANAME)'=X)
SET @EDITARY@(DATANUM,DATANAME)=Y
+17 KILL DIRUT
End DoDot:1
+18 IF ($DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT))&((ADDPKG)&(X="^"))
Begin DoDot:1
+19 KILL ^TMP("XTVS-PARAM-CAP",$JOB,PKGNME)
+20 DO HDR^XTVSLPDC
DO INIT^XTVSLPDC
+21 ;Do not prompt other fields
SET DATANUM=999
End DoDot:1
+22 IF $DATA(DUOUT)
IF (X["^")
IF ($LENGTH(X)>1)
Begin DoDot:1
+23 IF ADDPKG
Begin DoDot:2
+24 DO JUSTPAWS^XTVSLAPI(" Data Entry '^' JUMP not allowed before Primary Prefix is defined.")
+25 WRITE !
+26 SET DATANUM=1
+27 KILL DUOUT
End DoDot:2
+28 IF 'ADDPKG
DO JUMP(X,DATANUM)
SET DATANUM=DATANUM-1
End DoDot:1
+29 QUIT
+30 ;
HILOFLE(XTA,XTB,XTJUMPIN) ; Enter/Edit High or Low File Number
+1 IF $GET(XTJUMPIN)
NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
+2 SET DIR("A")=XTA
+3 if XTB]""
SET DIR("B")=XTB
+4 SET DIR("?",1)=" Enter File Number 0 - 999999999, decimals are allowed."
+5 SET DIR("?",2)=" "
+6 SET DIR("?",3)=" When File Ranges are undefined and *Lowest File# & *Highest File# are"
+7 SET DIR("?",4)=" defined, *Lowest File# - *Highest File# range is used to identify files"
+8 SET DIR("?")=" assigned to the package for the VistA Package Size report."
+9 SET DIR(0)="NOA^0:999999999:6"
+10 DO ^DIR
+11 IF ('$DATA(DTOUT)&('$DATA(DUOUT)))
Begin DoDot:1
+12 IF ($DATA(DIRUT))
DO UPDTNODE(DIRUT,EDITARY,DATANUM,DATANAME,X)
+13 IF '$DATA(DIRUT)
IF (@EDITARY@(DATANUM,DATANAME)'=X)
SET @EDITARY@(DATANUM,DATANAME)=Y
+14 KILL DIRUT
End DoDot:1
+15 IF $DATA(DUOUT)
IF (X["^")
DO JUMP(X,DATANUM)
SET DATANUM=DATANUM-1
+16 QUIT
+17 ;
EXADPFX(XTA,XTB,XTJUMPIN) ; Enter/Edit Excepted or Additional Prefixes
+1 NEW LISTDATA,PPRMT
+2 IF $GET(XTJUMPIN)
NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
+3 SET DIR("A")=XTA
+4 if XTB]""
SET DIR("B")=XTB
+5 SET GETOUT=0
+6 ;Edit Prefix List Loop
FOR
if GETOUT
QUIT
Begin DoDot:1
+7 SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
+8 ;Display Listed data to screen for user
DO SPLITOUT(DATANAME,LISTDATA)
+9 SET PPRMT="Enter "_$SELECT(DATANUM=5:"Additional",1:"Excepted")_" Prefix: "
+10 ;RESET DIR("A") default prompt
SET DIR("A")=PPRMT
+11 ;No default, select from list
KILL DIR("B")
+12 SET DIR("?",1)="Enter a new Prefix or one from list. [Note: Entry is case sensitive.]"
+13 SET DIR("?",2)="Order of Prefixes listed is not significant."
+14 SET DIR("?",3)=" "
+15 SET DIR("?",4)="Additional and Excepted Prefixes are used to identify Routines, Options,"
+16 SET DIR("?",5)=" Protocols, etc. for the VistA Package Size reporting tool. Additional"
+17 SET DIR("?",6)=" Prefixes include components [that begin with the prefix] in the tally"
+18 SET DIR("?",7)=" totals for the component. Excepted Prefixes are refinements to the"
+19 SET DIR("?",8)=" Primary and Additional Prefixes to exclude subsets of component names"
+20 SET DIR("?")=" [that begin with the Excepted Prefixes] from the tally totals."
+21 SET DIR(0)="FAO^2:6^K:(X'?1U1.5NU) X"
+22 DO ^DIR
+23 IF (Y=-1)!(Y="")!(Y="@")!($DATA(DTOUT))!($DATA(DUOUT))
SET GETOUT=1
+24 SET UPDATLST=0
+25 IF 'GETOUT
DO EDITPRFX(Y,.LISTDATA,.UPDATLST)
+26 IF GETOUT
IF $DATA(DUOUT)
IF (X["^")
DO JUMP(X,DATANUM)
SET DATANUM=DATANUM-1
+27 IF UPDATLST
SET @EDITARY@(DATANUM,DATANAME)=LISTDATA
End DoDot:1
+28 QUIT
+29 ;
EDITPRFX(DATELEMT,LISTDATA,UPDATLST) ; Update Prefix list
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y,EDTELEMT,PCE
+2 SET PCE=0
+3 IF (LISTDATA["|"_DATELEMT_"|")!($PIECE(LISTDATA,"|")=DATELEMT)
SET PCE=$$PCEPOS(LISTDATA,DATELEMT)
+4 SET DIR("A")=" Prefix: "
+5 SET DIR("B")=DATELEMT
+6 SET DIR("?")=" Enter/Edit a Prefix."
+7 SET DIR(0)="FAO^2:6^K:(X'?1U1.5NU) X"
+8 DO ^DIR
+9 IF '$DATA(DTOUT)&'$DATA(DUOUT)&'$DATA(DIROUT)
DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
+10 QUIT
+11 ;
LSTEDT(EDTELEMT,PCE,DATELEMT,LISTDATA,UPDATLST) ;Edit List dialog
+1 ;EDIT ENTRY
IF (PCE>0)
IF (EDTELEMT'="@")
SET $PIECE(LISTDATA,"|",PCE)=EDTELEMT
SET UPDATLST=1
+2 IF (PCE>0)
IF (EDTELEMT="@")
Begin DoDot:1
+3 IF +$$YNCHK^XTVSLAPI("DELETE ENTRY")
SET LISTDATA=$PIECE(LISTDATA,DATELEMT_"|",1)_$PIECE(LISTDATA,DATELEMT_"|",2)
SET UPDATLST=1
End DoDot:1
+4 IF PCE'>0
Begin DoDot:1
+5 IF EDTELEMT="@"
WRITE !,"?? ...Element not in list, cannot delete!"
SET EDTELEMT=DATELEMT
+6 IF +$$YNCHK^XTVSLAPI("ADD ENTRY")
SET LISTDATA=LISTDATA_EDTELEMT_"|"
SET UPDATLST=1
End DoDot:1
+7 QUIT
+8 ;
FLENUM(XTA,XTB,XTJUMPIN) ; Enter/Edit File number
+1 NEW LISTDATA
+2 IF $GET(XTJUMPIN)
NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
+3 SET DIR("A")=XTA
+4 if XTB]""
SET DIR("B")=XTB
+5 SET GETOUT=0
+6 ;Edit Prefix List Loop
FOR
if GETOUT
QUIT
Begin DoDot:1
+7 SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
+8 ;Display Listed data to screen for user
DO SPLITOUT(DATANAME,LISTDATA)
+9 ;RESET DIR("A") default prompt
SET DIR("A")="Enter File Number: "
+10 ;No default, select from list
KILL DIR("B")
+11 SET DIR("?",1)="Enter a new File Number or one from the list."
+12 SET DIR("?",2)="New file numbers only between 1.9999 and 99999999.999999"
+13 SET DIR("?",3)="Order of File Numbers listed is not significant."
+14 SET DIR("?",4)=" "
+15 SET DIR("?",5)="When File Ranges and *Lowest File# & *Highest File# are undefined and"
+16 SET DIR("?",6)=" File Numbers exist, File Numbers are used to identify files assigned"
+17 SET DIR("?")=" to the package for the VistA Package Size report."
+18 SET DIR(0)="NAO^1.9999:99999999.999999:6"
+19 DO ^DIR
+20 IF (Y=-1)!(Y="")!(Y="@")!($DATA(DTOUT))!($DATA(DUOUT))
SET GETOUT=1
+21 SET UPDATLST=0
+22 IF 'GETOUT
DO EDITFNUM(Y,.LISTDATA,.UPDATLST)
+23 IF GETOUT
IF $DATA(DUOUT)
IF (X["^")
DO JUMP(X,DATANUM)
SET DATANUM=DATANUM-1
+24 IF UPDATLST
SET @EDITARY@(DATANUM,DATANAME)=LISTDATA
End DoDot:1
+25 QUIT
+26 ;
EDITFNUM(DATELEMT,LISTDATA,UPDATLST) ; Update File list
+1 NEW DIR,DIRUT,DTOUT,DUOUT,EDTELEMT,PCE
+2 SET PCE=0
+3 IF (LISTDATA["|"_DATELEMT_"|")!($PIECE(LISTDATA,"|")=DATELEMT)
SET PCE=$$PCEPOS(LISTDATA,DATELEMT)
+4 SET DIR("A")=" File Number: "
+5 SET DIR("B")=DATELEMT
+6 SET DIR("?")=" Enter/Edit a File Number."
+7 SET DIR(0)="NAO^1.9999:99999999.999999:6"
+8 DO ^DIR
+9 IF '$DATA(DTOUT)&'$DATA(DUOUT)&'$DATA(DIROUT)
DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
+10 QUIT
+11 ;
FLERNG(XTA,XTB,XTJUMPIN) ; Enter/Edit File Range
+1 NEW LISTDATA
+2 IF $GET(XTJUMPIN)
NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
+3 SET DIR("A")=XTA
+4 if XTB]""
SET DIR("B")=XTB
+5 SET GETOUT=0
+6 ;Edit Prefix List Loop
FOR
if GETOUT
QUIT
Begin DoDot:1
+7 SET LISTDATA=@EDITARY@(DATANUM,DATANAME)
+8 ;Display Listed data to screen for user
DO SPLITOUT(DATANAME,LISTDATA)
+9 ;RESET DIR("A") default prompt
SET DIR("A")="Enter File Number Range: "
+10 ;No default, select from list
KILL DIR("B")
+11 SET DIR("?",1)="Enter a new File Number Range or one from the list."
+12 SET DIR("?",2)="New file number ranges only between 1.9999 and 99999999.999999"
+13 SET DIR("?",3)="Order of File Ranges listed is not significant."
+14 SET DIR("?",4)="Example of a file range would be 500-501.9 with no spaces."
+15 SET DIR("?",5)=" "
+16 SET DIR("?",6)="If File Ranges are defined, they are used to identify files assigned to"
+17 SET DIR("?",7)=" the package whether or not *Lowest File# & *Highest File# or File"
+18 SET DIR("?")=" Numbers are defined."
+19 SET DIR(0)="FAO^3:31^K:$$BADRNG^XTVSLPD1(X) X"
+20 DO ^DIR
+21 IF (Y=-1)!(Y="")!(Y="@")!($DATA(DTOUT))!($DATA(DUOUT))
SET GETOUT=1
+22 SET UPDATLST=0
+23 IF 'GETOUT
DO EDITFRNG(Y,.LISTDATA,.UPDATLST)
+24 IF GETOUT
IF $DATA(DUOUT)
IF (X["^")
DO JUMP(X,DATANUM)
SET DATANUM=DATANUM-1
+25 IF UPDATLST
SET @EDITARY@(DATANUM,DATANAME)=LISTDATA
End DoDot:1
+26 QUIT
+27 ;
EDITFRNG(DATELEMT,LISTDATA,UPDATLST) ; Update File Range
+1 NEW DIR,DIRUT,DTOUT,DUOUT,EDTELEMT,PCE
+2 SET PCE=0
+3 IF (LISTDATA["|"_DATELEMT_"|")!($PIECE(LISTDATA,"|")=DATELEMT)
SET PCE=$$PCEPOS(LISTDATA,DATELEMT)
+4 SET DIR("A")=" File Number Range: "
+5 SET DIR("B")=DATELEMT
+6 SET DIR("?",1)=" Enter a new File Number Range or one from the list."
+7 SET DIR("?")="New file number ranges only between 1.9999 and 99999999.999999"
+8 SET DIR(0)="FAO^3:31^K:$$BADRNG^XTVSLPD1(X) X"
+9 DO ^DIR
+10 IF '$DATA(DTOUT)&'$DATA(DUOUT)&'$DATA(DIROUT)
DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
+11 QUIT
+12 ;
PRNTPKG(XTA,XTB,XTJUMPIN) ; Enter/edit Parent Package
+1 IF $GET(XTJUMPIN)
NEW DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
+2 ;
+3 NEW ITEMNUM,SELARY
+4 SET ITEMNUM=$$SETSELAY^XTVSLPDC(.SELARY)
+5 ;
+6 SET DIR("A")=XTA
+7 if XTB]""
SET DIR("B")=XTB
+8 SET DIR("A",1)=" "
+9 SET DIR("PRE")="D PRECHK^XTVSLPD2(.X,.LASTSPKG,.SELARY,.ITEMNUM)"
+10 SET DIR("?")="^DO PKGHLP^XTVSLPD2(ITEMNUM)"
+11 SET DIR("??")="^DO LISTOUT^XTVSLAPI(.SELARY)"
+12 SET DIR(0)="FAOr^1:50^K:((X'?.ANP)&(X'?1.4N)) X"
+13 DO ^DIR
+14 ;
+15 IF ($DATA(X))&('$DATA(DTOUT)&('$DATA(DUOUT)))
Begin DoDot:1
+16 IF ($DATA(DIRUT))
DO UPDTNODE(DIRUT,EDITARY,DATANUM,DATANAME,X)
+17 IF '$DATA(DIRUT)
IF (@EDITARY@(DATANUM,DATANAME)'=X)
SET @EDITARY@(DATANUM,DATANAME)=X
End DoDot:1
+18 IF $DATA(DUOUT)
IF ($GET(X)["^")
DO JUMP(X,DATANUM)
SET DATANUM=DATANUM-1
+19 QUIT
+20 ;
JUMP(XVAL,XTOLDNUM) ; Jump to a data element during edit
+1 NEW DTELMT,CT,SUBRTN,XTDONE,DATANAME,DIR,DATANUM,XTFOUND
+2 SET (XTFOUND,XTDONE)=0
+3 IF (XVAL?1"^"0.1"*"1.A0.1" "1.A0.1"#")
IF (XVAL'="^")
Begin DoDot:1
+4 SET XVAL=$$UP^XLFSTR($PIECE(XVAL,"^",2))
+5 IF (XTOLDNUM'=7)
IF (XTOLDNUM'=8)
IF ($$CKMATCH(XVAL,"FILE "))
SET DTELMT=$$FLESEL()
if DTELMT]""
DO JUMPEXC
SET XTDONE=1
+6 FOR CT=2:1
SET DTELMT=$TEXT(DATANAME+CT)
if $PIECE(DTELMT," ;;",2)="QUIT"
QUIT
if XTDONE
QUIT
Begin DoDot:2
+7 IF ($PIECE($PIECE(DTELMT," ;;",2),"^")[XVAL)
IF ($$CKMATCH(XVAL,$PIECE($PIECE(DTELMT," ;;",2),"^")))
IF ($PIECE($PIECE(DTELMT," ;;",2),"^",2)'=XTOLDNUM)
Begin DoDot:3
+8 DO JUMPEXC
+9 SET XTDONE=1
End DoDot:3
End DoDot:2
+10 IF 'XTFOUND
WRITE " ??"
KILL DUOUT,X
+11 IF XTFOUND
WRITE !," Return to "_$PIECE($PIECE($TEXT(DATANAME+XTOLDNUM)," ;;",2),"^",1)_"..."
End DoDot:1
+12 QUIT
+13 ;
JUMPEXC ;Jump to selected field [from JUMP api]
+1 SET XTFOUND=1
+2 SET DATANUM=$PIECE($PIECE(DTELMT," ;;",2),"^",2)
+3 SET DATANAME=$ORDER(@EDITARY@(DATANUM,""))
+4 ;Set DIR("A") prompt
SET DIR("A")=DATANAME_": "
+5 ;Set Prompt for DIR read
SET DIR("B")=$GET(@EDITARY@(DATANUM,DATANAME))
+6 DO @$PIECE($PIECE(DTELMT," ;;",2),"^",3)
+7 KILL DUOUT
+8 QUIT
+9 ;
CKMATCH(XTIN,XTDATNM) ; Check for sub-string match to data element name
+1 NEW RESULT
+2 SET RESULT=(XTIN=$EXTRACT(XTDATNM,1,$LENGTH(XTIN)))
+3 QUIT RESULT
+4 ;
FLESEL() ; Select FILE data element for JUMP
+1 NEW RESULT,DIR,X,Y,DUOUT,DIROUT,DTOUT,DIRUT
+2 SET RESULT=""
+3 SET DIR("A")=" Data Element Number: "
+4 SET DIR("?")=" Enter number 1 or 2."
+5 SET DIR("A",1)=" "
+6 SET DIR("A",2)=" Select Data Element:"
+7 SET DIR("A",3)=" 1) File Numbers"
+8 SET DIR("A",4)=" 2) File Ranges"
+9 ;SET DIR("A",5)=" "
+10 SET DIR(0)="NA^1:2"
+11 DO ^DIR
+12 IF '$DATA(DIRUT)
SET RESULT=$TEXT(DATANAME+(6+Y))
+13 QUIT RESULT
+14 ;
UPDTNODE(UPDIRUT,EDITARY,DATANUM,DATANAME,UPDX) ;Update ^TMP("XTVS-PARAM-CAP") array node with edits
+1 IF ('$DATA(UPDIRUT))
SET @EDITARY@(DATANUM,DATANAME)=UPDX
+2 IF $DATA(UPDIRUT)
Begin DoDot:1
+3 IF (UPDX="@")
IF (@EDITARY@(DATANUM,DATANAME)'="")
Begin DoDot:2
+4 IF +$$YNCHK^XTVSLAPI("DELETE ENTRY")
SET @EDITARY@(DATANUM,DATANAME)=""
End DoDot:2
+5 IF (UPDX'="@")
IF (@EDITARY@(DATANUM,DATANAME)'=UPDX)
SET @EDITARY@(DATANUM,DATANAME)=UPDX
End DoDot:1
+6 QUIT
+7 ;
SPLITOUT(DATANAME,LISTDATA) ; -- Split list data to separate lines as needed and output
+1 ; DATANAME - Data element name
+2 ; LISTDATA - Data element list
+3 ;
+4 NEW LINE,PCENUM,LISTPCE,NXSTPCE
+5 WRITE !!!,DATANAME_":"
+6 IF LISTDATA']""
WRITE !,"{no data list}"
+7 IF LISTDATA]""
Begin DoDot:1
+8 IF $LENGTH(LISTDATA)'>79
WRITE !,LISTDATA
+9 IF $LENGTH(LISTDATA)>79
Begin DoDot:2
+10 SET LINE=""
+11 SET NXSTPCE=1
+12 FOR PCENUM=1:1
SET LISTPCE=$PIECE(LISTDATA,"|",PCENUM)
if LISTPCE=""
QUIT
Begin DoDot:3
+13 IF $LENGTH($PIECE(LISTDATA,"|",NXSTPCE,PCENUM))>79
WRITE !,$PIECE(LISTDATA,"|",NXSTPCE,PCENUM-1)
SET NXSTPCE=PCENUM
End DoDot:3
+14 WRITE !,$PIECE(LISTDATA,"|",NXSTPCE,999)
End DoDot:2
End DoDot:1
+15 WRITE !
+16 QUIT
+17 ;
PCEPOS(LISTDATA,DATELEMT) ; Return the piece position number of DATELEMT in LISTDATA
+1 NEW PCE,DELIMPOS,ITEM
+2 FOR PCE=1:1
SET ITEM=$PIECE(LISTDATA,"|",PCE)
if ITEM=DATELEMT
QUIT
IF ITEM=""
SET PCE=0
QUIT
+3 QUIT PCE
+4 ;
PRECHK(X,LASTSPKG,SELARY,ITEMNUM) ; PRNTPKG X value DIR("PRE") pre-check
+1 IF (X=" ")
IF ($GET(LASTSPKG)]"")
SET X=LASTSPKG
WRITE " ",X
+2 IF (X'="@")
IF (X'["^")
IF ($EXTRACT(X,1)'["?")
DO CHKX^XTVSLPD2(.X,.SELARY,.ITEMNUM)
+3 QUIT
+4 ;
CHKX(X,SELARY,ITEMNUM) ;Check X for Package [called by PRECHK via DIR("PRE") in PRNTPKG]
+1 IF X'?.N
Begin DoDot:1
+2 NEW PARAMSTR
+3 ;No adding items
SET PARAMSTR("ADDITM")=0
+4 ; Case matters
SET PARAMSTR("XTUPCASE")=0
+5 SET PARAMSTR("PATRN")=".ANP"
+6 SET PARAMSTR("MINLNG")=4
+7 SET PARAMSTR("MAXLNG")=50
+8 SET SELARY=""
+9 ;
+10 SET PARAMSTR("ITEMNUM")=ITEMNUM
+11 DO SELLIST^XTVSLPR2(.SELARY,.ITEMNUM,.X,.PARAMSTR)
End DoDot:1
+12 ;
+13 IF $DATA(X)
IF (X?.N)
IF (X>ITEMNUM)
KILL X
+14 IF $DATA(X)
IF (+$GET(X)>0)
SET (LASTSPKG,X)=SELARY(X)
WRITE " ",X
+15 ;
+16 QUIT
+17 ;
PKGHLP(ITEMUM) ; Parent Package selection help
+1 WRITE !,"Enter the name or number (1-"_ITEMNUM_") of the desired Parent Package."
+2 WRITE !," Package Name is case sensitive."
+3 WRITE !," Enter '??' for a numbered list of items OR '^' to exit.",!
+4 WRITE !,"Parent Package indicates an association with a package that may include"
+5 WRITE !," component intersections causing duplicate counting of Routines, Options,"
+6 WRITE !," Protocols, Files, etc. by the VistA Package Size report. For the VistA"
+7 WRITE !," Package Size Analysis Management tools, it is informational."
+8 WRITE !," However for VistA development management teams, it can mean more.",!
+9 QUIT
+10 ;
DATANAME ; Package Parameter data element names
+1 ;;PACKAGE NAME^1^PKGNME(DIR("A"),DIR("B"),1);;<place holder if Package name becomes editable>
+2 ;;PRIMARY PREFIX^2^PRIMPFX(DIR("A"),DIR("B"),1)
+3 ;;*LOWEST FILE#^3^HILOFLE(DIR("A"),DIR("B"),1)
+4 ;;*HIGHEST FILE#^4^HILOFLE(DIR("A"),DIR("B"),1)
+5 ;;ADDITIONAL PREFIXES^5^EXADPFX(DIR("A"),DIR("B"),1)
+6 ;;EXCEPTED PREFIXES^6^EXADPFX(DIR("A"),DIR("B"),1)
+7 ;;FILE NUMBERS^7^FLENUM(DIR("A"),DIR("B"),1)
+8 ;;FILE RANGES^8^FLERNG(DIR("A"),DIR("B"),1)
+9 ;;PARENT PACKAGE^9^PRNTPKG(DIR("A"),DIR("B"),1)
+10 ;;QUIT
