[796] | 1 | TMGHUI1 ;TMG/kst/Custom version of HUI code ;03/25/06
|
---|
| 2 | ;;1.0;TMG-LIB;**1**;01/12/05
|
---|
| 3 |
|
---|
| 4 |
|
---|
| 5 | HUIPSUPD ;DLD/Pacific HUI/Updates orderable item file with PS Orderable Items ; 1/25/05 7:55am
|
---|
| 6 | ;;This routine populates the drug orderable items
|
---|
| 7 |
|
---|
| 8 | ;"HUI MISCELLANEOUS FUNCTIONS (used/customized in TMG library)
|
---|
| 9 |
|
---|
| 10 | ;"=======================================================================
|
---|
| 11 | ;" API -- Public Functions.
|
---|
| 12 | ;"=======================================================================
|
---|
| 13 | ;"myGO ;" - global list- (global lister)
|
---|
| 14 |
|
---|
| 15 | ;"=======================================================================
|
---|
| 16 | ;"PRIVATE API FUNCTIONS
|
---|
| 17 | ;"=======================================================================
|
---|
| 18 |
|
---|
| 19 | ;"=======================================================================
|
---|
| 20 | ;"=======================================================================
|
---|
| 21 |
|
---|
| 22 | EN
|
---|
| 23 | ;" loop through PS(50.7 and add to OE Ordeable item
|
---|
| 24 | new PSOIEN
|
---|
| 25 | do DT^DICRW
|
---|
| 26 | set PSOIEN=$order(^PS(50.7,0))
|
---|
| 27 | if +PSOIEN>0 for do quit:'PSOIEN
|
---|
| 28 | . do ADD(PSOIEN)
|
---|
| 29 | . set PSOIEN=$order(^PS(50.7,PSOIEN))
|
---|
| 30 | quit
|
---|
| 31 |
|
---|
| 32 |
|
---|
| 33 | ADD(PSOIEN)
|
---|
| 34 | ;" Calls PS Orderable Item update routines
|
---|
| 35 | do EN^PSSPOIDT(PSOIEN)
|
---|
| 36 | do EN2^PSSHL1(PSOIEN,"MUP")
|
---|
| 37 | quit
|
---|
| 38 |
|
---|
| 39 | SET
|
---|
| 40 | ;" - updates view set
|
---|
| 41 | new DIC,X,Y,IEN,D,TYPE,NM,DGNM,UPDTIME,ATTEMPT
|
---|
| 42 | do DT^DICRW
|
---|
| 43 | set DIC="^ORD(101.44,"
|
---|
| 44 | set DIC(0)="AQ"
|
---|
| 45 | for D ^DIC quit:+Y quit:X="^"
|
---|
| 46 | quit:X="^"
|
---|
| 47 | set IEN=+Y
|
---|
| 48 | set NM=$P(Y,U,2)
|
---|
| 49 | set DGNM=$P(NM,"ORWDSET ",2)
|
---|
| 50 | set UPDTIME=$H
|
---|
| 51 | set ATTEMPT=""
|
---|
| 52 | do FVBLD^ORWUL
|
---|
| 53 | quit
|
---|
| 54 |
|
---|
| 55 |
|
---|
| 56 | myGO;" - global list- (global lister)
|
---|
| 57 | ;- Jan 2005 - DLD - PACIFIC HUI
|
---|
| 58 | ; - THis routine allows global out of a partial global
|
---|
| 59 | ;" //kt note: Obtained from N. Anthracite 11/4/05. She got
|
---|
| 60 | ;" it from Norman Dodd <norman.dodd@bluecliffinc.com>
|
---|
| 61 | ;" Reformatted for full commands
|
---|
| 62 | ;" User interface changes made also.
|
---|
| 63 | ;" This function dumps one or more globals to selected output device
|
---|
| 64 |
|
---|
| 65 | write !,"Global Output Utility",!
|
---|
| 66 | if '$data(%zdebug) new $et do
|
---|
| 67 | . set $et="zg "_$zl_":ERR^%GO"
|
---|
| 68 | . use $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%GO")
|
---|
| 69 | new g,gn,m,n,c,gl,in,%ZD,%ZG,%ZH,fmt
|
---|
| 70 | set c=0
|
---|
| 71 | for read !,"Enter Global ([enter] if done): ",in,! do quit:in=""
|
---|
| 72 | . quit:in=""
|
---|
| 73 | . if $extract(in)="?",$length(in)=1 do help quit
|
---|
| 74 | . if $extract(in)="^",$length(in)=1 set in="" quit
|
---|
| 75 | . if $extract(in)'="^" do help quit
|
---|
| 76 | . if in["(",in'[")" do help quit
|
---|
| 77 | . set c=c+1,gl(c)=in
|
---|
| 78 | if '$data(gl) write !,"No globals selected" quit
|
---|
| 79 | read !,"Header Label: ",%ZH,!
|
---|
| 80 | read !,"Output Format: GO or ZWR: ",fmt,!
|
---|
| 81 | if (fmt="")!($extract("ZWR",1,$length(fmt))=$translate(fmt,"zwr","ZWR")) set fmt=1
|
---|
| 82 | else set fmt=0
|
---|
| 83 | for do quit:$length(%ZD)
|
---|
| 84 | . read !,"Output device: <terminal>: ",%ZD,!
|
---|
| 85 | . if '$length(%ZD) set %ZD=$p quit
|
---|
| 86 | . if %ZD="^" quit
|
---|
| 87 | . if %ZD="?" do quit
|
---|
| 88 | . . write !!,"Select the device you want for output"
|
---|
| 89 | . . write !,"If you wish to exit enter a carat (^)",!
|
---|
| 90 | . . set %ZD=""
|
---|
| 91 | . if $zparse(%ZD)="" write " no such device" set %ZD="" quit
|
---|
| 92 | . open %ZD:(newversion:block=2048:record=2044:exception="g noopen"):0
|
---|
| 93 | . if '$t write !,%ZD," is not available" set %ZD="" quit
|
---|
| 94 | . quit
|
---|
| 95 | noopen . write !,$p($ZS,",",2,999),! close %ZD set %ZD=""
|
---|
| 96 | quit:%ZD="^"
|
---|
| 97 | write !!
|
---|
| 98 | if '$length(%ZH) set %ZH="%GO Global Output Utility"
|
---|
| 99 | use %ZD
|
---|
| 100 | write %ZH,!,"GT.M ",$zd($h,"DD-MON-YEAR 24:60:SS")
|
---|
| 101 | write:fmt " ZWR"
|
---|
| 102 | write !
|
---|
| 103 | set c=0,(m,n)=0
|
---|
| 104 | for set c=$order(gl(c)) quit:'+c set gn=gl(c),g=gn do
|
---|
| 105 | . use $p
|
---|
| 106 | . write:$x>70 !
|
---|
| 107 | . write gn,?$x\10+1*10
|
---|
| 108 | . use %ZD
|
---|
| 109 | . if $p=%ZD write !
|
---|
| 110 | . quit:g=""
|
---|
| 111 | . set m=m+1
|
---|
| 112 | . if $data(@g)'[0 write g do set n=n+1
|
---|
| 113 | . . if fmt write "=" do fw(@g)
|
---|
| 114 | . . else write !,@g,!
|
---|
| 115 | . for set g=$q(@g) quit:g="" do
|
---|
| 116 | . . if fmt zwr @g
|
---|
| 117 | . . else write g,!,@g,!
|
---|
| 118 | . . set n=n+1
|
---|
| 119 | use %ZD write !!
|
---|
| 120 | use $p
|
---|
| 121 | write !!,"Total of ",n," node",$s(n=1:"",1:"s")
|
---|
| 122 | write " in ",m," global",$s(m=1:".",1:"s."),!!
|
---|
| 123 | close:%ZD'=$p %ZD
|
---|
| 124 | use $p:(ctrap="":exc="")
|
---|
| 125 | quit
|
---|
| 126 |
|
---|
| 127 | fw(s)
|
---|
| 128 | ;" variables used in this function are: fwlen, s, cc, fastate, isctl, i, thistime
|
---|
| 129 | ;" initialize this procedure
|
---|
| 130 | set fwlen=$length(s)
|
---|
| 131 | if fwlen=0 write ! quit
|
---|
| 132 | if s=+s write s,! quit
|
---|
| 133 | set cc=$extract(s)
|
---|
| 134 | if cc?1C write "$C(",$a(cc) set fastate=2
|
---|
| 135 | else write """",cc w:cc="""" cc set fastate=1
|
---|
| 136 | ;" start the loop to deal with the whole string.
|
---|
| 137 | for i=2:1:fwlen set cc=$extract(s,i,i),isctl=cc?1C d
|
---|
| 138 | . set thistime=1
|
---|
| 139 | . if fastate=1 do
|
---|
| 140 | . . if (isctl) write """_$C(",$a(cc) set fastate=2,thistime=0
|
---|
| 141 | . . else write cc w:cc="""" cc
|
---|
| 142 | . if (fastate=2)&thistime do
|
---|
| 143 | . . if (isctl)!(cc="""") write ",",$a(cc)
|
---|
| 144 | . . else write ")_""",cc set fastate=1
|
---|
| 145 | if fastate=1 write """",!
|
---|
| 146 | else write ")",!
|
---|
| 147 | quit
|
---|
| 148 |
|
---|
| 149 | ERR use $p write !,$p($zs,",",2,99),!
|
---|
| 150 | ; Warning - Fall-though
|
---|
| 151 | set $ec=""
|
---|
| 152 | EXIT if $data(%ZD),%ZD'=$p close %ZD
|
---|
| 153 | use $p:(ctrap="":exc="")
|
---|
| 154 | quit
|
---|
| 155 |
|
---|
| 156 | help;
|
---|
| 157 | write !,"Enter a global reference to start at with ^"
|
---|
| 158 | write !,"i.e ^DPT or ^VA(200)"
|
---|
| 159 | quit
|
---|