- 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
- ;
- 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 ;
