A1VSLPD1.m

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 ---A1VSLPD1   3814     printed  Mar 13, 2025@20:43:25                                                                                                                                                                                                    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