AUSYSPE ;ENTER/EDIT IHS SPECIFIC PARAMETERS [ 02/03/87 9:52 AM ]
Z W !!,"EDIT 'IHS' SYSTEM PARAMETERS",!! D DT^DICRW,^AUSITE D DEFCK G END:$D(A("DEFCK"))
A1 W !!,"Select APPLICATION SYSTEM: " D SBRS G END:$D(DFOUT),END:$D(DTOUT),B1:$D(DQOUT),END:Y=""
S C=0,N="",L=$L(Y)
A2 S N=$O(^AUTTSYS(DUZ(2),N)) G A3:N="",A2:'$D(^(N,1,0)) S X=$P(^(0),"^",1)
I $E(X,1,L)=Y S C=C+1,AUSYS=N W:C+1 $E(X,L+1,99) W:C>1 !,?5,X
G A2
A3 G A4:C=1 W " ??" I 'C G B1
G A1
NOASK ;ENTRY POINT
;SET "AUSYS" EQUAL TO NAMESPACE
A4 D:'$D(DUZ(2)) ^AUSITE D DEFCK G END:$D(A("DEFCK")) W !!,"Edit ",$P(^AUTTSYS(DUZ(2),AUSYS,1,0),"^",1)," Parameters"
W ! S DIE="^AUTTSYS(DUZ(2),"""_AUSYS_""",",DA=1,DR=".02:9999" D ^DIE
G END
B1 W !!,"Select From: ",!,?50 S N=""
B2 S N=$O(^AUTTSYS(DUZ(2),N)) G B9:N="" I $D(^(N,1,0)) W:$X>45 !,?5 W $P(^(0),"^",1),?44
G B2
B9 W !! G A1
END K AUSYS,A("DEFCK"),X,Y,DA,DR,DIE,N,D,DIC,D0,DQ,%DT Q
DEFCK K A("DEFCK") I '$D(^AUTTSYS(DUZ(2))) W *7,!,"The PARAMETER FILE has not been established for this facility.",!!,"Please contact your system support person.",!! H 5 S A("DEFCK")=""
Q
GET ;ENTRY POINT - "AUSYS" EQUALS NAMESPACE; DUZ(2) ALREADY DEFINED
D DEFCK G END:$D(A("DEFCK"))
S Y=AUSYS_"OPT" K @Y Q:'$D(^AUTTSYS(DUZ(2),AUSYS,1,0)) S Z="",I=2,K=1
G1 S Z=$O(^(Z)) I Z="" K D,Z,Y,I,K,AUSYS Q
S D=^(Z) G G1:D'["^" F I=I:1 S @(Y_"(K)=$P(D,""^"",I)"),K=K+1 Q:I=$L(D,"^")
S I=1 G G1
SBRS K DFOUT,DTOUT,DUOUT,DQOUT,DLOUT R Y:DTIME I '$T W *7 R Y:5 G SBRS:Y="." I '$T S (DTOUT,DFOUT)="" Q
S:Y="" DLOUT="" S:Y="^" (DUOUT,Y)="" S:Y?1"?".E!(Y["^") (DQOUT,Y)=""
Q
AUSYSPE ;ENTER/EDIT IHS SPECIFIC PARAMETERS [ 02/03/87 9:52 AM ]
Z WRITE !!,"EDIT 'IHS' SYSTEM PARAMETERS",!!
DO DT^DICRW
DO ^AUSITE
DO DEFCK
IF $DATA(A("DEFCK"))
GOTO END
A1 WRITE !!,"Select APPLICATION SYSTEM: "
DO SBRS
IF $DATA(DFOUT)
GOTO END
IF $DATA(DTOUT)
GOTO END
IF $DATA(DQOUT)
GOTO B1
IF Y=""
GOTO END
+1 SET C=0
SET N=""
SET L=$LENGTH(Y)
A2 SET N=$ORDER(^AUTTSYS(DUZ(2),N))
IF N=""
GOTO A3
IF '$DATA(^(N,1,0))
GOTO A2
SET X=$PIECE(^(0),"^",1)
+1 IF $EXTRACT(X,1,L)=Y
SET C=C+1
SET AUSYS=N
IF C+1
WRITE $EXTRACT(X,L+1,99)
IF C>1
WRITE !,?5,X
+2 GOTO A2
A3 IF C=1
GOTO A4
WRITE " ??"
IF 'C
GOTO B1
+1 GOTO A1
NOASK ;ENTRY POINT
+1 ;SET "AUSYS" EQUAL TO NAMESPACE
A4 IF '$DATA(DUZ(2))
DO ^AUSITE
DO DEFCK
IF $DATA(A("DEFCK"))
GOTO END
WRITE !!,"Edit ",$PIECE(^AUTTSYS(DUZ(2),AUSYS,1,0),"^",1)," Parameters"
+1 WRITE !
SET DIE="^AUTTSYS(DUZ(2),"""_AUSYS_""","
SET DA=1
SET DR=".02:9999"
DO ^DIE
+2 GOTO END
B1 WRITE !!,"Select From: ",!,?50
SET N=""
B2 SET N=$ORDER(^AUTTSYS(DUZ(2),N))
IF N=""
GOTO B9
IF $DATA(^(N,1,0))
IF $X>45
WRITE !,?5
WRITE $PIECE(^(0),"^",1),?44
+1 GOTO B2
B9 WRITE !!
GOTO A1
END KILL AUSYS,A("DEFCK"),X,Y,DA,DR,DIE,N,D,DIC,D0,DQ,%DT
QUIT
DEFCK KILL A("DEFCK")
IF '$DATA(^AUTTSYS(DUZ(2)))
WRITE *7,!,"The PARAMETER FILE has not been established for this facility.",!!,"Please contact your system support person.",!!
HANG 5
SET A("DEFCK")=""
+1 QUIT
GET ;ENTRY POINT - "AUSYS" EQUALS NAMESPACE; DUZ(2) ALREADY DEFINED
+1 DO DEFCK
IF $DATA(A("DEFCK"))
GOTO END
+2 SET Y=AUSYS_"OPT"
KILL @Y
IF '$DATA(^AUTTSYS(DUZ(2),AUSYS,1,0))
QUIT
SET Z=""
SET I=2
SET K=1
G1 SET Z=$ORDER(^(Z))
IF Z=""
KILL D,Z,Y,I,K,AUSYS
QUIT
+1 SET D=^(Z)
IF D'["^"
GOTO G1
FOR I=I:1
SET @(Y_"(K)=$P(D,""^"",I)")
SET K=K+1
IF I=$LENGTH(D,"^")
QUIT
+2 SET I=1
GOTO G1
SBRS KILL DFOUT,DTOUT,DUOUT,DQOUT,DLOUT
READ Y:DTIME
IF '$TEST
WRITE *7
READ Y:5
IF Y="."
GOTO SBRS
IF '$TEST
SET (DTOUT,DFOUT)=""
QUIT
+1 IF Y=""
SET DLOUT=""
IF Y="^"
SET (DUOUT,Y)=""
IF Y?1"?".E!(Y["^")
SET (DQOUT,Y)=""
+2 QUIT
