INHSYS04 ;slt,JPD; 31 Jan 96 15:58;System Configuration data utility
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
RTNBFR(%TT,INROU) ;routine buffer/builder machine
;input:
; %TT --> (required) Transaction Type ien used to uniquely id TT
;output:
; INROU --> array of compiled routines in the IB* name-space.
; format: INROU(routine name)=""
;local:
; %RTN --> routine root name to build
; %NODE --> global node result of $Q
; %DATA --> string of data
; INMAX --> maximum allowable routine source size
; INOS --> operating system ien
; INZI --> code to insert line into the routine directory
; %ODD --> odd numbered offset
; %EVEN --> even numbered offset
;
N %CC,%LC,INMAX,INOS,INZI,%RTN,%NODE,%DATA,%T,%RTNBFR,%ODD,%EVEN,%RC
K ^UTILITY($J,0)
S INMAX=^DD("ROU"),INOS=^("OS"),INZI=^("OS",INOS,"ZS")
S %CC=INMAX*2,%LC=0,%RC="00",%RTN="IB"_$$ID(%TT),%NODE="^UTILITY($J)"
I %RTN="IB" W !,"The UNIQUE IDENTIFIER for this INTERFACE TRANSACTION TYPE does not exist!","Aborting!" K ^UTILITY($J) S INPOP=1 Q
S %RTNBFR="^UTILITY(""""INHSYS"""","
F S %NODE=$Q(@%NODE) Q:$$QS^INHUTIL(%NODE,1)'=$J D
.S %DATA=@%NODE
.I %CC+$L(%DATA)+$L(%NODE)'<INMAX D NEWR
.D LN(" ;;"_%NODE,.%CC,.%LC)
.D LN(" ;;"_%DATA,.%CC,.%LC)
I $O(^UTILITY($J,0,0)) D
.D LN(" Q",.%CC,.%LC) S X=%RTN_$S($L(%RC)=1:"0"_%RC,1:%RC) X INZI W !,X_" filed." S INROU(X)=""
.K ^UTILITY($J,0)
K ^UTILITY($J)
Q
NEWR ; Current routine will be too big so finish
; current routine and start new one
I $O(^UTILITY($J,0,0)) D
.S X=%RTN_$S($L(%RC)=1:"0"_%RC,1:%RC)
.D LN(" Q",.%CC,.%LC)
.X INZI W X_" filed.",! S INROU(X)=""
.K ^UTILITY($J,0)
S %CC=0,%RC=$$HEXUP(%RC),%LC=0
S %T=%RTN_$S($L(%RC)=1:"0"_%RC,1:%RC)_" ;"_$$INITIALS^INHUT5($P($G(^DIC(3,DUZ,0)),U))_";"_$$DATIM^INHUT5()_";compiled gis system data"
D LN(%T,.%CC,.%LC),LN(" ;;V1; "_$$DATIM^INHUT5(),.%CC,.%LC)
D LN(" ;COPYRIGHT "_(1700+$E(DT,1,3))_" SAIC",.%CC,.%LC)
D LN(" ;"_$P($G(^INRHT(%TT,0)),U),.%CC,.%LC)
D LN(" ;Compiled by: "_$P($G(^DIC(3,DUZ,0)),U),.%CC,.%LC),LN(" Q",.%CC,.%LC)
D LN(" ;",.%CC,.%LC)
D LN("EN F I=1:2 S %ODD=$E($T(EN+I),4,999) Q:%ODD="""" S %EVEN=$E($T(EN+(I+1)),4,999) S X="""_%RTNBFR_"""_$J_"",""_$P(%ODD,"","",2,99),@X=%EVEN",.%CC,.%LC)
Q
;
HEXUP(%H) ;hexidecimal increment
;input:
; %H --> hexidecimal number
;output:
; %Y --> %H+1
;local:
; SUM --> result of addition
; %HEX --> 1. string of valid hexidecimal characters
; 2. array of parsed hexidecimal characters converted into
; equivalent decimal values i.e HEX(1)=15
;
N I,SUM,%HEX,DIVIDEND,DIVISOR,REMAIN,QUOTIENT,%Y,J,%LEN
S %HEX="0123456789ABCDEF",%LEN=$L(%H)
F I=%LEN-1:-1:0 S %HEX(I)=$F(%HEX,$E(%H))-2,%H=$E(%H,2,%LEN)
;convert hexidecimal to decimal
S J="",SUM=0
F S J=$O(%HEX(J),-1) Q:J="" S SUM=SUM+(%HEX(J)*$$POW(16,J))
;increment number
S SUM=SUM+1
;convert decimal to hexidecimal
S DIVIDEND=SUM,DIVISOR=16,REMAIN=0
F I=1:1 D Q:'QUOTIENT
.S QUOTIENT=DIVIDEND\DIVISOR
.S REMAIN(I)=$E(%HEX,DIVIDEND#DIVISOR+1)
.S DIVIDEND=QUOTIENT
;rebuild number
S (J,%Y)=""
F S J=$O(REMAIN(J),-1) Q:'J S %Y=%Y_REMAIN(J)
Q %Y
;
POW(X,N) ;power function where X is raised to the Nth power
;input:
; X --> base
; N --> exponent
;output:
; POW --> the result of the Nth power of X
;
N POW
I 'N S POW=1
E S POW=X*$$POW(X,N-1)
Q POW
;
ID(X) ;fetch unique identifier for transaction type in X
; Input: X - Transaction Type
; Returns: UNIQUE IDENTIFIER
; If the UNIQUE IDENTIFIER is NULL, this should
; denote an error condition
Q $P(^INRHT(X,0),U,4)
;
NTRNL(INROU,X) ;procedure to compile internal installation driver
;input:
; INROU --> array of compiled data routines
; X --> driver name
;local:
; %CC --> character counter
; %LC --> routine line counter
; INOS --> ien of current operating system
; INZI --> routine insert execute logic
;
N %CC,%LC,INRTN,INOS,INZI
S INOS=^DD("OS"),INZI=^("OS",INOS,"ZS")
D LN(X_" ;"_$$INITIALS^INHUT5($P($G(^DIC(3,DUZ,0)),U))_";"_$$DATIM^INHUT5()_";gis system configuration installation",.%CC,.%LC)
D LN(" ;;V1; "_$$DATIM^INHUT5(),.%CC,.%LC)
D LN(" ;COPYRIGHT "_(1700+$E(DT,1,3))_" SAIC",.%CC,.%LC)
D LN(" ;"_$P($G(^INRHT(+$O(^INRHT("ID",$E(X,3,6),"")),0)),U),.%CC,.%LC)
D LN(" ;Compiled by: "_$P($G(^DIC(3,DUZ,0)),U),.%CC,.%LC)
D LN(" Q",.%CC,.%LC),LN(" ;",.%CC,.%LC)
D LN("EN ;entry point",.%CC,.%LC)
S INRTN=""
F S INRTN=$O(INROU(INRTN)) Q:INRTN="" D LN(" D EN^"_INRTN,.%CC,.%LC)
D LN(" Q",.%CC,.%LC) X INZI W !,X," internal driver filed.",!
K ^UTILITY($J,0)
Q
;
LN(%X,%CC,%LC) ;insert a line into routine buffer ^UTILITY($J,0,n)
;input:
; %X --> line of text to store
; %CC --> character counter
; %LC --> line counter
;
S %CC=$G(%CC)+$L($G(%X)),%LC=$G(%LC)+1
S ^UTILITY($J,0,%LC)=$G(%X)
Q
;
RTNINB(X) ;WOM 8/8/95
;Return the "IBvxxx" based on transaction name
;Return NULL if not found
;Note: If the UNIQUE IDENTIFIER of the INTERFACE TRANSACTION
; TYPE is invalid, $$ID will return NULL which will
; cause this function to return "IB" which should denote
; an error condition
;INPUT: X = TRANSACTION NAME, i.e., the 01 field
N DIC,Y S DIC="^INRHT(",DIC(0)="X" D ^DIC
Q $S(Y=""!(Y<0):"",1:"IB"_$$ID(+Y))
INHSYS04 ;slt,JPD; 31 Jan 96 15:58;System Configuration data utility
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
RTNBFR(%TT,INROU) ;routine buffer/builder machine
+1 ;input:
+2 ; %TT --> (required) Transaction Type ien used to uniquely id TT
+3 ;output:
+4 ; INROU --> array of compiled routines in the IB* name-space.
+5 ; format: INROU(routine name)=""
+6 ;local:
+7 ; %RTN --> routine root name to build
+8 ; %NODE --> global node result of $Q
+9 ; %DATA --> string of data
+10 ; INMAX --> maximum allowable routine source size
+11 ; INOS --> operating system ien
+12 ; INZI --> code to insert line into the routine directory
+13 ; %ODD --> odd numbered offset
+14 ; %EVEN --> even numbered offset
+15 ;
+16 NEW %CC,%LC,INMAX,INOS,INZI,%RTN,%NODE,%DATA,%T,%RTNBFR,%ODD,%EVEN,%RC
+17 KILL ^UTILITY($JOB,0)
+18 SET INMAX=^DD("ROU")
SET INOS=^("OS")
SET INZI=^("OS",INOS,"ZS")
+19 SET %CC=INMAX*2
SET %LC=0
SET %RC="00"
SET %RTN="IB"_$$ID(%TT)
SET %NODE="^UTILITY($J)"
+20 IF %RTN="IB"
WRITE !,"The UNIQUE IDENTIFIER for this INTERFACE TRANSACTION TYPE does not exist!","Aborting!"
KILL ^UTILITY($JOB)
SET INPOP=1
QUIT
+21 SET %RTNBFR="^UTILITY(""""INHSYS"""","
+22 FOR
SET %NODE=$QUERY(@%NODE)
IF $$QS^INHUTIL(%NODE,1)'=$JOB
QUIT
Begin DoDot:1
+23 SET %DATA=@%NODE
+24 IF %CC+$LENGTH(%DATA)+$LENGTH(%NODE)'<INMAX
DO NEWR
+25 DO LN(" ;;"_%NODE,.%CC,.%LC)
+26 DO LN(" ;;"_%DATA,.%CC,.%LC)
End DoDot:1
+27 IF $ORDER(^UTILITY($JOB,0,0))
Begin DoDot:1
+28 DO LN(" Q",.%CC,.%LC)
SET X=%RTN_$SELECT($LENGTH(%RC)=1:"0"_%RC,1:%RC)
XECUTE INZI
WRITE !,X_" filed."
SET INROU(X)=""
+29 KILL ^UTILITY($JOB,0)
End DoDot:1
+30 KILL ^UTILITY($JOB)
+31 QUIT
NEWR ; Current routine will be too big so finish
+1 ; current routine and start new one
+2 IF $ORDER(^UTILITY($JOB,0,0))
Begin DoDot:1
+3 SET X=%RTN_$SELECT($LENGTH(%RC)=1:"0"_%RC,1:%RC)
+4 DO LN(" Q",.%CC,.%LC)
+5 XECUTE INZI
WRITE X_" filed.",!
SET INROU(X)=""
+6 KILL ^UTILITY($JOB,0)
End DoDot:1
+7 SET %CC=0
SET %RC=$$HEXUP(%RC)
SET %LC=0
+8 SET %T=%RTN_$SELECT($LENGTH(%RC)=1:"0"_%RC,1:%RC)_" ;"_$$INITIALS^INHUT5($PIECE($GET(^DIC(3,DUZ,0)),U))_";"_$$DATIM^INHUT5()_";compiled gis system data"
+9 DO LN(%T,.%CC,.%LC)
DO LN(" ;;V1; "_$$DATIM^INHUT5(),.%CC,.%LC)
+10 DO LN(" ;COPYRIGHT "_(1700+$EXTRACT(DT,1,3))_" SAIC",.%CC,.%LC)
+11 DO LN(" ;"_$PIECE($GET(^INRHT(%TT,0)),U),.%CC,.%LC)
+12 DO LN(" ;Compiled by: "_$PIECE($GET(^DIC(3,DUZ,0)),U),.%CC,.%LC)
DO LN(" Q",.%CC,.%LC)
+13 DO LN(" ;",.%CC,.%LC)
+14 DO LN("EN F I=1:2 S %ODD=$E($T(EN+I),4,999) Q:%ODD="""" S %EVEN=$E($T(EN+(I+1)),4,999) S X="""_%RTNBFR_"""_$J_"",""_$P(%ODD,"","",2,99),@X=%EVEN",.%CC,.%LC)
+15 QUIT
+16 ;
HEXUP(%H) ;hexidecimal increment
+1 ;input:
+2 ; %H --> hexidecimal number
+3 ;output:
+4 ; %Y --> %H+1
+5 ;local:
+6 ; SUM --> result of addition
+7 ; %HEX --> 1. string of valid hexidecimal characters
+8 ; 2. array of parsed hexidecimal characters converted into
+9 ; equivalent decimal values i.e HEX(1)=15
+10 ;
+11 NEW I,SUM,%HEX,DIVIDEND,DIVISOR,REMAIN,QUOTIENT,%Y,J,%LEN
+12 SET %HEX="0123456789ABCDEF"
SET %LEN=$LENGTH(%H)
+13 FOR I=%LEN-1:-1:0
SET %HEX(I)=$FIND(%HEX,$EXTRACT(%H))-2
SET %H=$EXTRACT(%H,2,%LEN)
+14 ;convert hexidecimal to decimal
+15 SET J=""
SET SUM=0
+16 FOR
SET J=$ORDER(%HEX(J),-1)
IF J=""
QUIT
SET SUM=SUM+(%HEX(J)*$$POW(16,J))
+17 ;increment number
+18 SET SUM=SUM+1
+19 ;convert decimal to hexidecimal
+20 SET DIVIDEND=SUM
SET DIVISOR=16
SET REMAIN=0
+21 FOR I=1:1
Begin DoDot:1
+22 SET QUOTIENT=DIVIDEND\DIVISOR
+23 SET REMAIN(I)=$EXTRACT(%HEX,DIVIDEND#DIVISOR+1)
+24 SET DIVIDEND=QUOTIENT
End DoDot:1
IF 'QUOTIENT
QUIT
+25 ;rebuild number
+26 SET (J,%Y)=""
+27 FOR
SET J=$ORDER(REMAIN(J),-1)
IF 'J
QUIT
SET %Y=%Y_REMAIN(J)
+28 QUIT %Y
+29 ;
POW(X,N) ;power function where X is raised to the Nth power
+1 ;input:
+2 ; X --> base
+3 ; N --> exponent
+4 ;output:
+5 ; POW --> the result of the Nth power of X
+6 ;
+7 NEW POW
+8 IF 'N
SET POW=1
+9 IF '$TEST
SET POW=X*$$POW(X,N-1)
+10 QUIT POW
+11 ;
ID(X) ;fetch unique identifier for transaction type in X
+1 ; Input: X - Transaction Type
+2 ; Returns: UNIQUE IDENTIFIER
+3 ; If the UNIQUE IDENTIFIER is NULL, this should
+4 ; denote an error condition
+5 QUIT $PIECE(^INRHT(X,0),U,4)
+6 ;
NTRNL(INROU,X) ;procedure to compile internal installation driver
+1 ;input:
+2 ; INROU --> array of compiled data routines
+3 ; X --> driver name
+4 ;local:
+5 ; %CC --> character counter
+6 ; %LC --> routine line counter
+7 ; INOS --> ien of current operating system
+8 ; INZI --> routine insert execute logic
+9 ;
+10 NEW %CC,%LC,INRTN,INOS,INZI
+11 SET INOS=^DD("OS")
SET INZI=^("OS",INOS,"ZS")
+12 DO LN(X_" ;"_$$INITIALS^INHUT5($PIECE($GET(^DIC(3,DUZ,0)),U))_";"_$$DATIM^INHUT5()_";gis system configuration installation",.%CC,.%LC)
+13 DO LN(" ;;V1; "_$$DATIM^INHUT5(),.%CC,.%LC)
+14 DO LN(" ;COPYRIGHT "_(1700+$EXTRACT(DT,1,3))_" SAIC",.%CC,.%LC)
+15 DO LN(" ;"_$PIECE($GET(^INRHT(+$ORDER(^INRHT("ID",$EXTRACT(X,3,6),"")),0)),U),.%CC,.%LC)
+16 DO LN(" ;Compiled by: "_$PIECE($GET(^DIC(3,DUZ,0)),U),.%CC,.%LC)
+17 DO LN(" Q",.%CC,.%LC)
DO LN(" ;",.%CC,.%LC)
+18 DO LN("EN ;entry point",.%CC,.%LC)
+19 SET INRTN=""
+20 FOR
SET INRTN=$ORDER(INROU(INRTN))
IF INRTN=""
QUIT
DO LN(" D EN^"_INRTN,.%CC,.%LC)
+21 DO LN(" Q",.%CC,.%LC)
XECUTE INZI
WRITE !,X," internal driver filed.",!
+22 KILL ^UTILITY($JOB,0)
+23 QUIT
+24 ;
LN(%X,%CC,%LC) ;insert a line into routine buffer ^UTILITY($J,0,n)
+1 ;input:
+2 ; %X --> line of text to store
+3 ; %CC --> character counter
+4 ; %LC --> line counter
+5 ;
+6 SET %CC=$GET(%CC)+$LENGTH($GET(%X))
SET %LC=$GET(%LC)+1
+7 SET ^UTILITY($JOB,0,%LC)=$GET(%X)
+8 QUIT
+9 ;
RTNINB(X) ;WOM 8/8/95
+1 ;Return the "IBvxxx" based on transaction name
+2 ;Return NULL if not found
+3 ;Note: If the UNIQUE IDENTIFIER of the INTERFACE TRANSACTION
+4 ; TYPE is invalid, $$ID will return NULL which will
+5 ; cause this function to return "IB" which should denote
+6 ; an error condition
+7 ;INPUT: X = TRANSACTION NAME, i.e., the 01 field
+8 NEW DIC,Y
SET DIC="^INRHT("
SET DIC(0)="X"
DO ^DIC
+9 QUIT $SELECT(Y=""!(Y<0):"",1:"IB"_$$ID(+Y))
