A1VSLPD1 ;Albany FO/GTS - VistA Package Sizing Manager - Caption display APIs; 12-JUL-2016
;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
;
;APIs
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
DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
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
DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
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^A1VSLPD1(X) X"
DO ^DIR
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^A1VSLAPI("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
. SET:+$$YNCHK^A1VSLAPI("ADD ENTRY") LISTDATA=LISTDATA_EDTELEMT_"|" SET UPDATLST=1
QUIT
;
UPDTNODE(UPDIRUT,EDITARY,DATANUM,DATANAME,UPDX,CHNGMADE) ;Update ^TMP("A1VS-PARAM-EDIT") array node
IF ('$D(UPDIRUT)) SET @EDITARY@(DATANUM,DATANAME)=UPDX SET CHNGMADE=1
IF $D(UPDIRUT) DO
. IF (UPDX="@"),(@EDITARY@(DATANUM,DATANAME)'="") DO
.. IF +$$YNCHK^A1VSLAPI("DELETE ENTRY") SET @EDITARY@(DATANUM,DATANAME)="" SET CHNGMADE=1
. IF (UPDX'="@"),(@EDITARY@(DATANUM,DATANAME)'=UPDX) SET @EDITARY@(DATANUM,DATANAME)=UPDX SET CHNGMADE=1
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
;
BADRNG(X) ;Checks user entered File Range (used by DIR call)
SET RESULT=0
IF ((X'?1.N."."0.6N1"-"1.N."."0.6N)!($P(X,"-",2)<$P(X,"-"))) SET RESULT=1
QUIT RESULT
;
SETSTR(PKGARY) ;Return a string of Package File Lineitem (Concatonate fields to 1 HDR line)
NEW LINEITM,LPCNT,FLD
SET LINEITM=""
SET LPCNT=0
FOR SET LPCNT=$O(@CAPARY@(LPCNT)) Q:LPCNT="" DO
. SET FLD=$O(@CAPARY@(LPCNT,""))
. SET LINEITM=LINEITM_@CAPARY@(LPCNT,FLD)_$S(LPCNT<9:"^",1:"")
QUIT LINEITM
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1VSLPD1 3814 printed Sep 23, 2025@19:14:44 Page 2
A1VSLPD1 ;Albany FO/GTS - VistA Package Sizing Manager - Caption display APIs; 12-JUL-2016
+1 ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
+2 ;
+3 ;APIs
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 DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
+10 QUIT
+11 ;
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 DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
+10 QUIT
+11 ;
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^A1VSLPD1(X) X"
+9 DO ^DIR
+10 DO LSTEDT(X,PCE,DATELEMT,.LISTDATA,.UPDATLST)
+11 QUIT
+12 ;
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^A1VSLAPI("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^A1VSLAPI("ADD ENTRY")
SET LISTDATA=LISTDATA_EDTELEMT_"|"
SET UPDATLST=1
End DoDot:1
+7 QUIT
+8 ;
UPDTNODE(UPDIRUT,EDITARY,DATANUM,DATANAME,UPDX,CHNGMADE) ;Update ^TMP("A1VS-PARAM-EDIT") array node
+1 IF ('$DATA(UPDIRUT))
SET @EDITARY@(DATANUM,DATANAME)=UPDX
SET CHNGMADE=1
+2 IF $DATA(UPDIRUT)
Begin DoDot:1
+3 IF (UPDX="@")
IF (@EDITARY@(DATANUM,DATANAME)'="")
Begin DoDot:2
+4 IF +$$YNCHK^A1VSLAPI("DELETE ENTRY")
SET @EDITARY@(DATANUM,DATANAME)=""
SET CHNGMADE=1
End DoDot:2
+5 IF (UPDX'="@")
IF (@EDITARY@(DATANUM,DATANAME)'=UPDX)
SET @EDITARY@(DATANUM,DATANAME)=UPDX
SET CHNGMADE=1
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 ;
BADRNG(X) ;Checks user entered File Range (used by DIR call)
+1 SET RESULT=0
+2 IF ((X'?1.N."."0.6N1"-"1.N."."0.6N)!($PIECE(X,"-",2)<$PIECE(X,"-")))
SET RESULT=1
+3 QUIT RESULT
+4 ;
SETSTR(PKGARY) ;Return a string of Package File Lineitem (Concatonate fields to 1 HDR line)
+1 NEW LINEITM,LPCNT,FLD
+2 SET LINEITM=""
+3 SET LPCNT=0
+4 FOR
SET LPCNT=$ORDER(@CAPARY@(LPCNT))
if LPCNT=""
QUIT
Begin DoDot:1
+5 SET FLD=$ORDER(@CAPARY@(LPCNT,""))
+6 SET LINEITM=LINEITM_@CAPARY@(LPCNT,FLD)_$SELECT(LPCNT<9:"^",1:"")
End DoDot:1
+7 QUIT LINEITM
+8 ;
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
