INHDIA(%T,%F) ;GFT,JSH; 16 Nov 95 16:22;Generic Interface - create an Input Template
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;
;%T = name of template
;%F = file number^global reference
;Enter with ^UTILITY("INDIA",$J,n) [n=1,2,3...] containing the lines for the template
;
S DIC=U_$P(%F,U,2) N T S:'$D(DMAX) DMAX=$G(^DD("ROU")) S:'DMAX DMAX=4000
S DIA=DIC,DI=+%F,(J(0),DIA("P"))=DI,DIA("DIET")=$G(^DIC(DI,0,"DIET"))
D QQ S DR="",(DIEFMT,L,DIAR,DRS,DIAP,DB,DSC)=0,F=-1,I(0)=DIA,DXS=1 D EN
Q:'$O(^UTILITY("INDIA",$J,0))
S INI=0 F S INI=$O(^UTILITY("INDIA",$J,INI)) Q:'INI S X=^(INI) W:'(INI#5) "." D L
F Q:'F D UP
STORE ;Store the template
F F=0:0 S F=$O(^UTILITY($J,"OV",F)) Q:'F F X=0:0 S X=$O(^UTILITY($J,"OV",F,X)) Q:'X S DW=DR(F,X),DR(F,X)=^(X,0),I=1 D OV
G S
;
OV I '$D(^(I)) S DR(F,X,I)=DW Q
S DR(F,X,I)=^(I),I=I+1 G OV
;
S S DIC="^DIE(",DIC(0)="LZ",DIC("S")="I $P(^(0),U,4)="_+%F,D="F"_+%F,X=%T D IX^DIC K DIC S %=$P(Y,U,3)
L +^DIE K ^DIE(+Y) S ^(+Y,0)=X_U_DT_U_"@"_U_+%F_U_U_"@",^DIE("F"_+%F,X,+Y)=1 L -^DIE K ^UTILITY($J,"OV")
M ^DIE(+Y,"DR")=DR,^DIE(+Y,"DIAB")=^UTILITY($J)
S X=%T D EN^DIEZ
;
Q K DI,DLAYGO,DIA,I,J
QQ K ^UTILITY($J),DICHK,DIAT,DIART,DIAR,DIAB,DIAO,DIAP,DIAA,IOP,DSC,DIA3,DHIT,DRS,DIE,DR,DA,DG,DIC,F,DP,DQ,DV,DB,DW,D,X,Y,L Q
1 Q
L K DIC,DIAB,DIAM S DSC=X?1"^".E I DSC S X=$E(X,2,999) I U[X K DR Q
I $A(X)=64 G AT^INHDIA3:X'?1P.N,P:$L(X)>1,X:'DB S DB=DB+1 G 2
D DICS S DV="",J=$P(X,"-",2)
DIC ;
K Y S DIC(0)="Z",DIC="^DD(DI," D ^DIC
I Y>0 D SET S Y=$P(Y(0),U,2) G 2:'Y S X=DI,L=L+1,(DI,J(L))=+Y,I(L)=""""_$P($P(Y(0),U,4),";")_"""" G DOWN
F D=124,93 I $A(X)=D S:D=124 DIAB=X,DIAM=1 S DRS=9,X=$E(X,2,999) G DIC:X]"",UP
S DIC(0)="Y",D="GR" I $D(^DD(DI,D)) D IX^DIC I Y>0 D SET G 2
G X^INHDIA3
;
F S X=$P(^DD(DI,0),U) I F,X="FIELD" S X=$O(^(0,"NM",0))_" "_X
Q
;
X ;
W !,*7,"Field: '"_$P(^UTILITY("INDIA",$J,INI),"///")_"' is invalid in template. (It may be COMPUTED)" K Y D DICS
2 ;
Q
UP ;
Q:'F
K I(L),J(L) S L=L-1 I '$D(J(L)) F L=L-99:1 Q:'$D(J(L+1))
I DB S DB=DB(F),DIART=DIART(F),DIAO=DIAO(F),DIAT=$S(DIAO<0:"",DIAO:^DIE(DIAA,"DR",DIART,J(L),DIAO),$D(^DIE(DIAA,"DR",DIART,J(L))):^(J(L)),1:"")
S DIAR=DIAR(F),DIAP=DIAP(F),DI=J(L),F=F-1 G 2
;
EN ;
D DICS
DOWN S F=F+1,DIAP(F)=DIAP,DIAP=0,DIAR(F)=DIAR F %=F+1:.01 I '$D(DR(%,DI)) S:%["." DR(DIAR,X)=DR(DIAR,X)_U_%_";",DIAP(F)=DIAP(F)+1 S DIAR=% Q
G GO:'DB!$D(DIEFMT) S DIART(F)=DIART,DIART=F+1,%=$P(DIAT,";",DB) I %?1"^".NP S DIART=$P(%,U,2),DB=DB+1
S DB(F)=DB,DB=1,DIAO(F)=DIAO,DIAO=0,DIAT=$G(^DIE(DIAA,"DR",DIART,DI))
GO G 1:$D(DIAM),1:$O(^DD(DI,.01))>0,1:L#100=0,UP
DICS ;
S DIC("S")="I Y>.001,$P(^(0),U,2)'[""C"" Q:$G(^(9))="""" I ^(9)'=U" I DUZ(0)'="@" S DIC("S")="I $P(^(0),U,2)'[""Q"" "_DIC("S")_",$TR(DUZ(0),^(9))'=DUZ(0)"
Q
;
P ;
S DRS=99,Y=X D DB G 2
;
SET S Y=+Y_DV
DB ;
I DB,'DSC S DB=DB+1
D ;
I '$D(DR(DIAR,DI)) S DR(DIAR,DI)="",DIAP=0
E I $L(DR(DIAR,DI))+$L(Y)>230 F %=0:1 I '$D(^UTILITY($J,"OV",DIAR,DI,%)) S DIAP=DIAP\1000+1*1000,^(%)=DR(DIAR,DI),DR(DIAR,DI)="" Q
S DR(DIAR,DI)=DR(DIAR,DI)_Y_";",DRS=DRS+1,DIAP=DIAP+1 I $D(DIAB),Y'="Q" S ^UTILITY($J,DIAP#1000,DIAR-1,DI,DIAP\1000)=DIAB
INHDIA(%T,%F) ;GFT,JSH; 16 Nov 95 16:22;Generic Interface - create an Input Template
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;
+4 ;%T = name of template
+5 ;%F = file number^global reference
+6 ;Enter with ^UTILITY("INDIA",$J,n) [n=1,2,3...] containing the lines for the template
+7 ;
+8 SET DIC=U_$PIECE(%F,U,2)
NEW T
IF '$DATA(DMAX)
SET DMAX=$GET(^DD("ROU"))
IF 'DMAX
SET DMAX=4000
+9 SET DIA=DIC
SET DI=+%F
SET (J(0),DIA("P"))=DI
SET DIA("DIET")=$GET(^DIC(DI,0,"DIET"))
+10 DO QQ
SET DR=""
SET (DIEFMT,L,DIAR,DRS,DIAP,DB,DSC)=0
SET F=-1
SET I(0)=DIA
SET DXS=1
DO EN
+11 IF '$ORDER(^UTILITY("INDIA",$JOB,0))
QUIT
+12 SET INI=0
FOR
SET INI=$ORDER(^UTILITY("INDIA",$JOB,INI))
IF 'INI
QUIT
SET X=^(INI)
IF '(INI#5)
WRITE "."
DO L
+13 FOR
IF 'F
QUIT
DO UP
STORE ;Store the template
+1 FOR F=0:0
SET F=$ORDER(^UTILITY($JOB,"OV",F))
IF 'F
QUIT
FOR X=0:0
SET X=$ORDER(^UTILITY($JOB,"OV",F,X))
IF 'X
QUIT
SET DW=DR(F,X)
SET DR(F,X)=^(X,0)
SET I=1
DO OV
+2 GOTO S
+3 ;
OV IF '$DATA(^(I))
SET DR(F,X,I)=DW
QUIT
+1 SET DR(F,X,I)=^(I)
SET I=I+1
GOTO OV
+2 ;
S SET DIC="^DIE("
SET DIC(0)="LZ"
SET DIC("S")="I $P(^(0),U,4)="_+%F
SET D="F"_+%F
SET X=%T
DO IX^DIC
KILL DIC
SET %=$PIECE(Y,U,3)
+1 LOCK +^DIE
KILL ^DIE(+Y)
SET ^(+Y,0)=X_U_DT_U_"@"_U_+%F_U_U_"@"
SET ^DIE("F"_+%F,X,+Y)=1
LOCK -^DIE
KILL ^UTILITY($JOB,"OV")
+2 MERGE ^DIE(+Y,"DR")=DR,^DIE(+Y,"DIAB")=^UTILITY($JOB)
+3 SET X=%T
DO EN^DIEZ
+4 ;
Q KILL DI,DLAYGO,DIA,I,J
QQ KILL ^UTILITY($JOB),DICHK,DIAT,DIART,DIAR,DIAB,DIAO,DIAP,DIAA,IOP,DSC,DIA3,DHIT,DRS,DIE,DR,DA,DG,DIC,F,DP,DQ,DV,DB,DW,D,X,Y,L
QUIT
1 QUIT
L KILL DIC,DIAB,DIAM
SET DSC=X?1"^".E
IF DSC
SET X=$EXTRACT(X,2,999)
IF U[X
KILL DR
QUIT
+1 IF $ASCII(X)=64
IF X'?1P.N
GOTO AT^INHDIA3
IF $LENGTH(X)>1
GOTO P
IF 'DB
GOTO X
SET DB=DB+1
GOTO 2
+2 DO DICS
SET DV=""
SET J=$PIECE(X,"-",2)
DIC ;
+1 KILL Y
SET DIC(0)="Z"
SET DIC="^DD(DI,"
DO ^DIC
+2 IF Y>0
DO SET
SET Y=$PIECE(Y(0),U,2)
IF 'Y
GOTO 2
SET X=DI
SET L=L+1
SET (DI,J(L))=+Y
SET I(L)=""""_$PIECE($PIECE(Y(0),U,4),";")_""""
GOTO DOWN
+3 FOR D=124,93
IF $ASCII(X)=D
IF D=124
SET DIAB=X
SET DIAM=1
SET DRS=9
SET X=$EXTRACT(X,2,999)
IF X]""
GOTO DIC
GOTO UP
+4 SET DIC(0)="Y"
SET D="GR"
IF $DATA(^DD(DI,D))
DO IX^DIC
IF Y>0
DO SET
GOTO 2
+5 GOTO X^INHDIA3
+6 ;
F SET X=$PIECE(^DD(DI,0),U)
IF F
IF X="FIELD"
SET X=$ORDER(^(0,"NM",0))_" "_X
+1 QUIT
+2 ;
X ;
+1 WRITE !,*7,"Field: '"_$PIECE(^UTILITY("INDIA",$JOB,INI),"///")_"' is invalid in template. (It may be COMPUTED)"
KILL Y
DO DICS
2 ;
+1 QUIT
UP ;
+1 IF 'F
QUIT
+2 KILL I(L),J(L)
SET L=L-1
IF '$DATA(J(L))
FOR L=L-99:1
IF '$DATA(J(L+1))
QUIT
+3 IF DB
SET DB=DB(F)
SET DIART=DIART(F)
SET DIAO=DIAO(F)
SET DIAT=$SELECT(DIAO<0:"",DIAO:^DIE(DIAA,"DR",DIART,J(L),DIAO),$DATA(^DIE(DIAA,"DR",DIART,J(L))):^(J(L)),1:"")
+4 SET DIAR=DIAR(F)
SET DIAP=DIAP(F)
SET DI=J(L)
SET F=F-1
GOTO 2
+5 ;
EN ;
+1 DO DICS
DOWN SET F=F+1
SET DIAP(F)=DIAP
SET DIAP=0
SET DIAR(F)=DIAR
FOR %=F+1:.01
IF '$DATA(DR(%,DI))
IF %["."
SET DR(DIAR,X)=DR(DIAR,X)_U_%_";"
SET DIAP(F)=DIAP(F)+1
SET DIAR=%
QUIT
+1 IF 'DB!$DATA(DIEFMT)
GOTO GO
SET DIART(F)=DIART
SET DIART=F+1
SET %=$PIECE(DIAT,";",DB)
IF %?1"^".NP
SET DIART=$PIECE(%,U,2)
SET DB=DB+1
+2 SET DB(F)=DB
SET DB=1
SET DIAO(F)=DIAO
SET DIAO=0
SET DIAT=$GET(^DIE(DIAA,"DR",DIART,DI))
GO IF $DATA(DIAM)
GOTO 1
IF $ORDER(^DD(DI,.01))>0
GOTO 1
IF L#100=0
GOTO 1
GOTO UP
DICS ;
+1 SET DIC("S")="I Y>.001,$P(^(0),U,2)'[""C"" Q:$G(^(9))="""" I ^(9)'=U"
IF DUZ(0)'="@"
SET DIC("S")="I $P(^(0),U,2)'[""Q"" "_DIC("S")_",$TR(DUZ(0),^(9))'=DUZ(0)"
+2 QUIT
+3 ;
P ;
+1 SET DRS=99
SET Y=X
DO DB
GOTO 2
+2 ;
SET SET Y=+Y_DV
DB ;
+1 IF DB
IF 'DSC
SET DB=DB+1
D ;
+1 IF '$DATA(DR(DIAR,DI))
SET DR(DIAR,DI)=""
SET DIAP=0
+2 IF '$TEST
IF $LENGTH(DR(DIAR,DI))+$LENGTH(Y)>230
FOR %=0:1
IF '$DATA(^UTILITY($JOB,"OV",DIAR,DI,%))
SET DIAP=DIAP\1000+1*1000
SET ^(%)=DR(DIAR,DI)
SET DR(DIAR,DI)=""
QUIT
+3 SET DR(DIAR,DI)=DR(DIAR,DI)_Y_";"
SET DRS=DRS+1
SET DIAP=DIAP+1
IF $DATA(DIAB)
IF Y'="Q"
SET ^UTILITY($JOB,DIAP#1000,DIAR-1,DI,DIAP\1000)=DIAB
