ENJINJ1 ;(WASH ISC)/JA-Data Insertion and Look-up ;3-24-92
;;7.0;ENGINEERING;;Aug 17, 1993
G T1:'$D(DJDN) S DJXX=X,D="" G:DJ4["P" P G:X["^" ER S (DJDIC,DIE)=DIC,DA=DJDN S DR=DJ3_"///"_$S(X["/"!(X[";"):"^S X=DJXX",1:X) X DJCP W ! D ^DIE S DIC=DJDIC D KILL I $D(Y) S DJY=Y G Q1
I $D(ENXP) S V(V)=$E(X,1,DJJ(V)) D N^ENJINJ3 K ENXP
I DJ4["D" S (DJXX,Y)=X X ^DD("DD") S X=Y
I DJ4["S" S DJX=$P(DJ0,U,3),DJXX=X F DJK=1:1 I X=$P($P(DJX,";",DJK),":",1) S X=$P($P(DJX,";",DJK),":",2) Q
I '$D(DJY) S V(V)=$E(X,1,+DJJ(V)) D O S @$P(DJJ(V),U,2) X XY W @DJHIN X XY W V(V),@DJLIN S:DJ4["D"!(DJ4["S") X=DJXX X DJCP X:$D(^ENG(6910.9,DJN,1,$O(^ENG(6910.9,DJN,1,"A",V,0)),1)) ^(1) G NXT^ENJINJ
P I DJ4["P" D P^ENJINQ S @$P(DJJ(V),U,2) X XY G NXT^ENJINJ:$D(Y)=0,TK^ENJINJ
S V(V)=$S(X="@":"",1:X) D O X DJCP I $D(^ENG(6910.9,DJN,1,$O(^ENG(6910.9,DJN,1,"A",V,0)),1)) X DJCP S:DJ4["D" X=DJXX X ^(1) S @$P(DJJ(V),U,2) X XY
G:DJAT=.01&(V(V)="") Q^ENJINJ G T4^ENJINJ
Q1 S:'$D(X) X=DJXX D ^ENJINQ G TK^ENJINJ
T1 I $D(^ENG(6910.9,DJN,1,$O(^ENG(6910.9,DJN,1,"A",V,0)),1)) X DJCP X ^(1) S @$P(DJJ(V),U,2) X XY
G:DJAT=.01&($D(DJDN)=0) K1
G:DJAT=.01&(DJP) K1
I V(V)'="",X="" G NXT^ENJINJ
I V(V)'="" S @$P(DJJ(V),U,2) X XY W @DJHIN X XY W V(V),@DJLIN G NXT^ENJINJ
I V(V)="" S @$P(DJJ(V),U,2) X XY W @DJLIN S $P(DJDB,".",DJJ(V))="." W DJDB K DJDB G NXT^ENJINJ
G LH^ENJINJ
K1 G NXT^ENJINJ:X=""&($D(DJDN)),LST^ENJINJ:X=""&('$D(DJDN)) I $D(DJST),DJST=1 K ^TMP($J,"DJST"),DJST
; D DCS^ENJ
S:X'=" " DIC(0)="LMEQZ" S:X=" " DIC(0)="Z" X DJCP W X S:$D(DJDICS) DIC("S")=DJDICS D ^DIC K DIC("S") S DIC(0)="LMEQZ"
R !,"Type <CR> to continue",X:DTIME S DJSV=V,DJFF=0 D N^ENJDPL S V=DJSV
I Y<0 S @$P(DJJ(V),U,2),X="" X XY G TK^ENJINJ
S (X,V(V))=$P(Y(0),U,1),(DA,W(V))=+Y,DJDNM=V(V) S:'$D(DJST) DJST=1,D0=DA
C S:'DJP DJDN=+Y K Y,DJLK D ^ENJC2 X XY G NXT^ENJINJ
ER K X W *7 G Q1
WP ;PRINT WORD PROCESSOR FIELD
S DJDIC=DIC_DA_","_+$P(DJ0,"^",4)_"," S DJXX=X Q:'$D(@(DJDIC_"0)")) S DJZ1=0,DJX=0,DIWL=0,DIWR=79,DIWF="" K ^TMP($J,"W")
F DJK=1:1 S DJZ1=$O(@(DJDIC_DJZ1_")")) Q:DJZ1'?1N.N S X=@(DJDIC_DJZ1_",0)") D ^DIWP X DJCP
S DJZ1=0 F DJK=1:1 S DJZ1=$O(^TMP($J,"W",DIWL,DJZ1)) Q:DJZ1="" D:$Y>21 CONT Q:DJX[U W !,^(DJZ1,0)
D CONT K DJZ1,DJK,^TMP($J,"W",DIWL),DIWL,DIWR,DIWF S X=DJXX Q:DJX'[U
Q
CONT W !,"Type <CR> to continue, uparrow to exit: " R DJX:DTIME X DJCP W ! Q
R X DJCL W "Type <CR> to continue" R DJX:DTIME Q
EN ;COMPUTE AND DISPLAY
S @$P(DJJ(DJVV),U,2) X XY S $P(DJDB," ",+DJJ(V))=" " W DJDB X XY W @DJHIN X XY W V(DJVV),@DJLIN K DJDB Q
;
KILL K DB,DC,DG,DH,DE,DI,DK,DL,DM,DP,DW,DR Q
EN2 X DJCP W !!,"THIS IS NOT THE FIRST SCREEN",*7 R !,"Type <CR> to continue",X:DTIME S X="^" Q
O ;EX OUTPUT TRANSFROM
I $D(^DD(DJDD,DJAT,2)) S Y=X X ^(2) S (V(V),X)=Y
Q
EN3 ;ERROR ON DIE
G:'$D(Y) E X DJCP W !,"You have a bad default variable, please check with your",!,"Data Base administrator",*7
S @$P(DJJ(V),U,2),$P(DJDB,".",DJJ(V))="." X XY W @DJHIN X XY W DJDB,@DJLIN K DJDB X XY S V(V)="" Q
E S $P(DJDB," ",DJJ(V)-$L(V(V)))=" " X XY W @DJHIN X XY W V(V),DJDB,@DJLIN K DJDB Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENJINJ1 3106 printed Nov 22, 2024@17:04:13 Page 2
ENJINJ1 ;(WASH ISC)/JA-Data Insertion and Look-up ;3-24-92
+1 ;;7.0;ENGINEERING;;Aug 17, 1993
+2 if '$DATA(DJDN)
GOTO T1
SET DJXX=X
SET D=""
if DJ4["P"
GOTO P
if X["^"
GOTO ER
SET (DJDIC,DIE)=DIC
SET DA=DJDN
SET DR=DJ3_"///"_$SELECT(X["/"!(X[";"):"^S X=DJXX",1:X)
XECUTE DJCP
WRITE !
DO ^DIE
SET DIC=DJDIC
DO KILL
IF $DATA(Y)
SET DJY=Y
GOTO Q1
+3 IF $DATA(ENXP)
SET V(V)=$EXTRACT(X,1,DJJ(V))
DO N^ENJINJ3
KILL ENXP
+4 IF DJ4["D"
SET (DJXX,Y)=X
XECUTE ^DD("DD")
SET X=Y
+5 IF DJ4["S"
SET DJX=$PIECE(DJ0,U,3)
SET DJXX=X
FOR DJK=1:1
IF X=$PIECE($PIECE(DJX,";",DJK),":",1)
SET X=$PIECE($PIECE(DJX,";",DJK),":",2)
QUIT
+6 IF '$DATA(DJY)
SET V(V)=$EXTRACT(X,1,+DJJ(V))
DO O
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
WRITE @DJHIN
XECUTE XY
WRITE V(V),@DJLIN
if DJ4["D"!(DJ4["S")
SET X=DJXX
XECUTE DJCP
if $DATA(^ENG(6910.9,DJN,1,$ORDER(^ENG(6910.9,DJN,1,"A",V,0)),1))
XECUTE ^(1)
GOTO NXT^ENJINJ
P IF DJ4["P"
DO P^ENJINQ
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
if $DATA(Y)=0
GOTO NXT^ENJINJ
GOTO TK^ENJINJ
+1 SET V(V)=$SELECT(X="@":"",1:X)
DO O
XECUTE DJCP
IF $DATA(^ENG(6910.9,DJN,1,$ORDER(^ENG(6910.9,DJN,1,"A",V,0)),1))
XECUTE DJCP
if DJ4["D"
SET X=DJXX
XECUTE ^(1)
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
+2 if DJAT=.01&(V(V)="")
GOTO Q^ENJINJ
GOTO T4^ENJINJ
Q1 if '$DATA(X)
SET X=DJXX
DO ^ENJINQ
GOTO TK^ENJINJ
T1 IF $DATA(^ENG(6910.9,DJN,1,$ORDER(^ENG(6910.9,DJN,1,"A",V,0)),1))
XECUTE DJCP
XECUTE ^(1)
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
+1 if DJAT=.01&($DATA(DJDN)=0)
GOTO K1
+2 if DJAT=.01&(DJP)
GOTO K1
+3 IF V(V)'=""
IF X=""
GOTO NXT^ENJINJ
+4 IF V(V)'=""
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
WRITE @DJHIN
XECUTE XY
WRITE V(V),@DJLIN
GOTO NXT^ENJINJ
+5 IF V(V)=""
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
WRITE @DJLIN
SET $PIECE(DJDB,".",DJJ(V))="."
WRITE DJDB
KILL DJDB
GOTO NXT^ENJINJ
+6 GOTO LH^ENJINJ
K1 if X=""&($DATA(DJDN))
GOTO NXT^ENJINJ
if X=""&('$DATA(DJDN))
GOTO LST^ENJINJ
IF $DATA(DJST)
IF DJST=1
KILL ^TMP($JOB,"DJST"),DJST
+1 ; D DCS^ENJ
+2 if X'=" "
SET DIC(0)="LMEQZ"
if X=" "
SET DIC(0)="Z"
XECUTE DJCP
WRITE X
if $DATA(DJDICS)
SET DIC("S")=DJDICS
DO ^DIC
KILL DIC("S")
SET DIC(0)="LMEQZ"
+3 READ !,"Type <CR> to continue",X:DTIME
SET DJSV=V
SET DJFF=0
DO N^ENJDPL
SET V=DJSV
+4 IF Y<0
SET @$PIECE(DJJ(V),U,2)
SET X=""
XECUTE XY
GOTO TK^ENJINJ
+5 SET (X,V(V))=$PIECE(Y(0),U,1)
SET (DA,W(V))=+Y
SET DJDNM=V(V)
if '$DATA(DJST)
SET DJST=1
SET D0=DA
C if 'DJP
SET DJDN=+Y
KILL Y,DJLK
DO ^ENJC2
XECUTE XY
GOTO NXT^ENJINJ
ER KILL X
WRITE *7
GOTO Q1
WP ;PRINT WORD PROCESSOR FIELD
+1 SET DJDIC=DIC_DA_","_+$PIECE(DJ0,"^",4)_","
SET DJXX=X
if '$DATA(@(DJDIC_"0)"))
QUIT
SET DJZ1=0
SET DJX=0
SET DIWL=0
SET DIWR=79
SET DIWF=""
KILL ^TMP($JOB,"W")
+2 FOR DJK=1:1
SET DJZ1=$ORDER(@(DJDIC_DJZ1_")"))
if DJZ1'?1N.N
QUIT
SET X=@(DJDIC_DJZ1_",0)")
DO ^DIWP
XECUTE DJCP
+3 SET DJZ1=0
FOR DJK=1:1
SET DJZ1=$ORDER(^TMP($JOB,"W",DIWL,DJZ1))
if DJZ1=""
QUIT
if $Y>21
DO CONT
if DJX[U
QUIT
WRITE !,^(DJZ1,0)
+4 DO CONT
KILL DJZ1,DJK,^TMP($JOB,"W",DIWL),DIWL,DIWR,DIWF
SET X=DJXX
if DJX'[U
QUIT
+5 QUIT
CONT WRITE !,"Type <CR> to continue, uparrow to exit: "
READ DJX:DTIME
XECUTE DJCP
WRITE !
QUIT
R XECUTE DJCL
WRITE "Type <CR> to continue"
READ DJX:DTIME
QUIT
EN ;COMPUTE AND DISPLAY
+1 SET @$PIECE(DJJ(DJVV),U,2)
XECUTE XY
SET $PIECE(DJDB," ",+DJJ(V))=" "
WRITE DJDB
XECUTE XY
WRITE @DJHIN
XECUTE XY
WRITE V(DJVV),@DJLIN
KILL DJDB
QUIT
+2 ;
KILL KILL DB,DC,DG,DH,DE,DI,DK,DL,DM,DP,DW,DR
QUIT
EN2 XECUTE DJCP
WRITE !!,"THIS IS NOT THE FIRST SCREEN",*7
READ !,"Type <CR> to continue",X:DTIME
SET X="^"
QUIT
O ;EX OUTPUT TRANSFROM
+1 IF $DATA(^DD(DJDD,DJAT,2))
SET Y=X
XECUTE ^(2)
SET (V(V),X)=Y
+2 QUIT
EN3 ;ERROR ON DIE
+1 if '$DATA(Y)
GOTO E
XECUTE DJCP
WRITE !,"You have a bad default variable, please check with your",!,"Data Base administrator",*7
+2 SET @$PIECE(DJJ(V),U,2)
SET $PIECE(DJDB,".",DJJ(V))="."
XECUTE XY
WRITE @DJHIN
XECUTE XY
WRITE DJDB,@DJLIN
KILL DJDB
XECUTE XY
SET V(V)=""
QUIT
E SET $PIECE(DJDB," ",DJJ(V)-$LENGTH(V(V)))=" "
XECUTE XY
WRITE @DJHIN
XECUTE XY
WRITE V(V),DJDB,@DJLIN
KILL DJDB
QUIT
