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

INHSYS04.m

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