Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VALMW3

VALMW3.m

Go to the documentation of this file. 
  1. VALMW3 ; ALB/MJK - Create transport routines for LM;03:39 PM  16 Dec 1992
  1.  ;;1;List Manager;;Aug 13, 1993
  1.  ;
  1. EN ; -- exporter main entry point
  1.  N VALMSYS,VALMNS,VALMROU,VALMAX
  1.  S U="^",DTIME=600 K ^UTILITY($J)
  1.  D HOME^%ZIS
  1.  W @IOF,!?20,"*** List Template Export Utility ***"
  1.  I '$$DUZ() G ENQ
  1.  S VALMSYS=$$OS() I VALMSYS="" G ENQ
  1.  S VALMNS=$$NS() I VALMNS="" G ENQ
  1.  S VALMROU=$$ROU(.VALMNS) I VALMROU="" G ENQ
  1.  S VALMAX=$$MAX() I 'VALMAX G ENQ
  1.  W !!!,">>> Exporting LIST TEMPLATES with namespace '"_VALMNS_"'."
  1.  D BLD,FILE(.VALMROU)
  1. ENQ Q
  1.  ;
  1.  ;
  1. DUZ() ; -- check duz and duz(0)
  1.  I $S('$D(DUZ(0)):1,DUZ(0)'="@":1,1:0) D
  1.  .W !,"PROGRAMMER ACCESS REQUIRED",!
  1.  .S Y=0
  1.  E  S Y=1
  1.  Q Y
  1.  ;
  1. OS() ; -- get os #
  1.  I $D(^%ZOSF("OS"))#2 D
  1.  .S Y=+$P(^("OS"),"^",2)
  1.  E  S Y=0
  1.  Q Y
  1.  ;
  1. NS() ; -- ask for namespace
  1. NS1 S VALMNS=""
  1.  W !!,">>> Enter the Name of the Package (2-4 characters): "
  1.  R X:$S($D(DTIME):DTIME,1:60) G NSQ:"^"[X
  1.  I X'?1U1.NU!($L(X)>4) D NS^VALMW5 G NS1
  1.  S VALMNS="",DIC="^DIC(9.4,",DIC(0)="EZ",D="C" D IX^DIC
  1.  I Y>0 S SDPK=+Y,VALMNS=$P(Y(0),U,2)
  1.  S:Y<1!(VALMNS="") VALMNS=$$ADHOC(X)
  1. NSQ Q VALMNS
  1.  ;
  1. ROU(VALMNS) ; -- ask for export routine name
  1.  N ROU,DIR,X,Q
  1. ROU1 S VALMROU=""
  1.  W ! S:$G(VALMNS)]"" DIR("B")=VALMNS_"L"
  1.  S DIR("A")=">>> Enter Routine Name",DIR(0)="F^2:6^" D ^DIR K DIR
  1.  G ROUQ:"^"[Y S VALMROU=Y
  1.  W !!,"I am going to create a series of '",VALMROU,"*' routines."
  1.  I $D(^%ZOSF("TEST"))#2 X ^("TEST") I  W *7,!,"but '"_VALMROU_"' is ALREADY ON FILE!" S Q=1
  1.  W !,"Is that OK" D YN^DICN
  1.  I %<0!(%=2) S:%=2 VALMROU="" G ROUQ
  1.  I '% D ROU^VALMW5 G ROU1
  1. ROUQ Q VALMROU
  1.  ;
  1. MAX() ; -- ask for max size of routines
  1.  N Y
  1. MAX1 S Y=""
  1.  W !!,">>> MAXIMUM ROUTINE SIZE(BYTES): ",^DD("ROU"),"// "
  1.  R Y:$S($D(DTIME):DTIME,1:60) I '$T G MAXQ
  1.  S:Y="" Y=^DD("ROU")
  1.  I Y[U S Y="" G MAXQ
  1.  I Y\1'=Y!(Y<2000)!(Y>9999) D MAX^VALMW5 G MAX
  1. MAXQ Q Y
  1.  ;
  1. ADHOC(X) ; -- pick any namespace
  1. L W !!,"Package "_X_" not found"
  1.  W !,"Please enter the package namespace you wish to export: "
  1.  R X:300
  1.  I '$T!(X="")!(X'?1A.E) S X="" G LQ
  1.  I $L(X)>4 W !,"Namespace too long" G L
  1. LQ Q X
  1.  ;
  1. BLD ; -- build utility
  1.  N VALMLN,VALMX,VALMNAME,VALM,VALMGLB
  1.  S VALMLN=0,VALMX=VALMNS
  1.  F  S VALMX=$O(^SD(409.61,"B",VALMX)) Q:VALMX=""!($E(VALMX,1,$L(VALMNS))'=VALMNS)  S VALM=+$O(^(VALMX,0)) I $D(^SD(409.61,VALM,0)),$P(^(0),U,7) S VALMNAME=$P(^(0),U) D
  1.  .W !?5,"o  ",VALMNAME
  1.  .D SET(" W !,""'"_VALMNAME_"' List Template...""")
  1.  .D SET(" S DA=$O(^SD(409.61,""B"","""_VALMNAME_""",0)),DIK=""^SD(409.61,"" D ^DIK:DA")
  1.  .D SET(" K DO,DD S DIC(0)=""L"",DIC=""^SD(409.61,"",X="""_VALMNAME_""" D FILE^DICN S VALM=+Y")
  1.  .D SET(" I VALM>0 D")
  1.  .;
  1.  .S VALMGLB="^SD(409.61,"_VALM_",",X=VALMGLB_"-1)"
  1.  .F  S X=$Q(@X) Q:$E(X,1,$L(VALMGLB))'=VALMGLB  D:X'[",""B""," SET(" .S ^SD(409.61,VALM,"_$P(X,VALMGLB,2,99)_"="""_$$QUOTE(@X)_"""")
  1.  .;
  1.  .D SET(" .S DA=VALM,DIK=""^SD(409.61,"" D IX1^DIK K DA,DIK")
  1.  .D SET(" .W ""Filed.""")
  1.  .D SET(" ;")
  1.  D SET(" K DIC,DIK,VALM,X,DA Q")
  1. Q3 Q
  1.  ;
  1. SET(X) ; -- set line utility
  1.  S VALMLN=VALMLN+1,^UTILITY($J,VALMLN,0)=X W "."
  1.  Q
  1.  ;
  1. QUOTE(X) ; -- add double quotes
  1.  N P,L
  1.  S P=1,L=$L(X)
  1.  F  S P=$F(X,"""",P) Q:'P!(P>(L+1))  S X=$E(X,1,P-1)_""""_$E(X,P,L),L=L+1,P=P+1
  1.  Q X
  1.  ;
  1. FILE(VALMROU) ; -- file routines
  1.  N %H,VALMDATE,VALMNUM,VALMLN
  1.  S %H=+$H D YX^%DTC
  1.  S VALMDATE=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)
  1.  S VALMNUM="",VALMLN=0
  1.  F  D SAVE(.VALMROU,.VALMNUM,.VALMLN,.VALMDATE) Q:VALMLN=""  S VALMNUM=VALMNUM+1
  1.  Q
  1.  ;
  1. SAVE(VALMROU,VALMNUM,VALMLN,VALMDATE) ; -- save to routine
  1.  N LINE,SIZE
  1.  K ^UTILITY($J,0) S ^(0,1)=VALMROU_VALMNUM_" ; List Template Exporter ; "_VALMDATE,^(1.1)=" ;; ;",SIZE=0
  1.  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
  1.  I VALMLN,$O(^UTILITY($J,VALMLN)) S ^UTILITY($J,0,LINE+1)=" G ^"_VALMROU_(VALMNUM+1)
  1.  S X=VALMROU_VALMNUM X ^DD("OS",VALMSYS,"ZS") W !,X_" has been filed..."
  1.  Q
  1.  ;