VALMW4 ; ALB/MJK - Create STUB routine;04:07 PM 16 Dec 1992
;;1;List Manager;;Aug 13, 1993
;
EN(VALMIFN) ; -- stub builder
N VALMSYS,VALMNS,VALMROU,VALMAX
S U="^",DTIME=600 K ^UTILITY($J)
I '$$DUZ^VALMW3() G ENQ
S VALMSYS=$$OS^VALMW3() I VALMSYS="" G ENQ
W !!,">>> The system will create a stub routine..."
S VALMROU=$$ROU^VALMW3() I VALMROU="" G ENQ
S VALMAX=5000 ;$$MAX^VALMW3() I 'VALMAX G ENQ
W !!!,">>> Building '",VALMROU,"' stub routine..."
D BLD,FILE(.VALMROU),TEMP
ENQ Q
;
TEMP ; -- set defaults
S DIE="^SD(409.61,",DA=VALMIFN,DR="[VALM NEW ENTRY DEFAULTS]" D ^DIE
K DR,DA,DIE
Q
;
BLD ; -- build utility
N VALMLN,VALMNAME
S VALMLN=0
S VALMNAME=$P($G(^SD(409.61,VALMIFN,0)),U)
D SET("EN ; -- main entry point for "_VALMNAME)
D SET(" D EN^VALM("""_VALMNAME_""")")
D SET(" Q")
D SET(" ;")
D SET("HDR ; -- header code")
D SET(" S VALMHDR(1)=""This is a test header for "_VALMNAME_".""")
D SET(" S VALMHDR(2)=""This is the second line""")
D SET(" Q")
D SET(" ;")
D SET("INIT ; -- init variables and list array")
D SET(" F LINE=1:1:30 D SET^VALM10(LINE,LINE_"" Line number ""_LINE)")
D SET(" S VALMCNT=30")
D SET(" Q")
D SET(" ;")
D SET("HELP ; -- help code")
D SET(" S X=""?"" D DISP^XQORM1 W !!")
D SET(" Q")
D SET(" ;")
D SET("EXIT ; -- exit code")
D SET(" Q")
D SET(" ;")
D SET("EXPND ; -- expand code")
D SET(" Q")
D SET(" ;")
Q
;
SET(X) ; -- set line utility
S VALMLN=VALMLN+1,^UTILITY($J,VALMLN,0)=X W "."
Q
;
FILE(VALMROU) ; -- file routines
N %H,VALMDATE,VALMNUM,VALMLN
S %H=+$H D YX^%DTC
S VALMDATE=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)
S VALMNUM="",VALMLN=0
F D SAVE(.VALMROU,.VALMNUM,.VALMLN,.VALMDATE) Q:VALMLN="" S VALMNUM=VALMNUM+1
Q
;
SAVE(VALMROU,VALMNUM,VALMLN,VALMDATE) ; -- save to routine
N LINE,SIZE
K ^UTILITY($J,0) S ^(0,1)=VALMROU_VALMNUM_" ; ; "_VALMDATE,^(1.1)=" ;; ;",SIZE=0
F LINE=2:1 S VALMLN=$O(^UTILITY($J,VALMLN)) Q:VALMLN="" S ^UTILITY($J,0,LINE)=^(VALMLN,0),SIZE=$L(^(LINE))+SIZE I $E(^(LINE),1,2)'=" .",SIZE+700>VALMAX Q
I VALMLN,$O(^UTILITY($J,VALMLN)) S ^UTILITY($J,0,LINE+1)=" G "_VALMROU_(VALMNUM+1)
S X=VALMROU_VALMNUM X ^DD("OS",VALMSYS,"ZS") W !,X_" has been filed..."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVALMW4 2260 printed Oct 16, 2024@18:11:02 Page 2
VALMW4 ; ALB/MJK - Create STUB routine;04:07 PM 16 Dec 1992
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
EN(VALMIFN) ; -- stub builder
+1 NEW VALMSYS,VALMNS,VALMROU,VALMAX
+2 SET U="^"
SET DTIME=600
KILL ^UTILITY($JOB)
+3 IF '$$DUZ^VALMW3()
GOTO ENQ
+4 SET VALMSYS=$$OS^VALMW3()
IF VALMSYS=""
GOTO ENQ
+5 WRITE !!,">>> The system will create a stub routine..."
+6 SET VALMROU=$$ROU^VALMW3()
IF VALMROU=""
GOTO ENQ
+7 ;$$MAX^VALMW3() I 'VALMAX G ENQ
SET VALMAX=5000
+8 WRITE !!!,">>> Building '",VALMROU,"' stub routine..."
+9 DO BLD
DO FILE(.VALMROU)
DO TEMP
ENQ QUIT
+1 ;
TEMP ; -- set defaults
+1 SET DIE="^SD(409.61,"
SET DA=VALMIFN
SET DR="[VALM NEW ENTRY DEFAULTS]"
DO ^DIE
+2 KILL DR,DA,DIE
+3 QUIT
+4 ;
BLD ; -- build utility
+1 NEW VALMLN,VALMNAME
+2 SET VALMLN=0
+3 SET VALMNAME=$PIECE($GET(^SD(409.61,VALMIFN,0)),U)
+4 DO SET("EN ; -- main entry point for "_VALMNAME)
+5 DO SET(" D EN^VALM("""_VALMNAME_""")")
+6 DO SET(" Q")
+7 DO SET(" ;")
+8 DO SET("HDR ; -- header code")
+9 DO SET(" S VALMHDR(1)=""This is a test header for "_VALMNAME_".""")
+10 DO SET(" S VALMHDR(2)=""This is the second line""")
+11 DO SET(" Q")
+12 DO SET(" ;")
+13 DO SET("INIT ; -- init variables and list array")
+14 DO SET(" F LINE=1:1:30 D SET^VALM10(LINE,LINE_"" Line number ""_LINE)")
+15 DO SET(" S VALMCNT=30")
+16 DO SET(" Q")
+17 DO SET(" ;")
+18 DO SET("HELP ; -- help code")
+19 DO SET(" S X=""?"" D DISP^XQORM1 W !!")
+20 DO SET(" Q")
+21 DO SET(" ;")
+22 DO SET("EXIT ; -- exit code")
+23 DO SET(" Q")
+24 DO SET(" ;")
+25 DO SET("EXPND ; -- expand code")
+26 DO SET(" Q")
+27 DO SET(" ;")
+28 QUIT
+29 ;
SET(X) ; -- set line utility
+1 SET VALMLN=VALMLN+1
SET ^UTILITY($JOB,VALMLN,0)=X
WRITE "."
+2 QUIT
+3 ;
FILE(VALMROU) ; -- file routines
+1 NEW %H,VALMDATE,VALMNUM,VALMLN
+2 SET %H=+$HOROLOG
DO YX^%DTC
+3 SET VALMDATE=$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,9,12)
+4 SET VALMNUM=""
SET VALMLN=0
+5 FOR
DO SAVE(.VALMROU,.VALMNUM,.VALMLN,.VALMDATE)
if VALMLN=""
QUIT
SET VALMNUM=VALMNUM+1
+6 QUIT
+7 ;
SAVE(VALMROU,VALMNUM,VALMLN,VALMDATE) ; -- save to routine
+1 NEW LINE,SIZE
+2 KILL ^UTILITY($JOB,0)
SET ^(0,1)=VALMROU_VALMNUM_" ; ; "_VALMDATE
SET ^(1.1)=" ;; ;"
SET SIZE=0
+3 FOR LINE=2:1
SET VALMLN=$ORDER(^UTILITY($JOB,VALMLN))
if VALMLN=""
QUIT
SET ^UTILITY($JOB,0,LINE)=^(VALMLN,0)
SET SIZE=$LENGTH(^(LINE))+SIZE
IF $EXTRACT(^(LINE),1,2)'=" ."
IF SIZE+700>VALMAX
QUIT
+4 IF VALMLN
IF $ORDER(^UTILITY($JOB,VALMLN))
SET ^UTILITY($JOB,0,LINE+1)=" G "_VALMROU_(VALMNUM+1)
+5 SET X=VALMROU_VALMNUM
XECUTE ^DD("OS",VALMSYS,"ZS")
WRITE !,X_" has been filed..."
+6 QUIT
+7 ;
