- ENJINJ ;(WASH ISC)/JA/TJK-Screen Entry of Data ;1/8/2001
- ;;7.0;ENGINEERING;**39,55,69**;Aug 17, 1993
- K DJDN
- I '$D(DJDN)&($P(DJJ,U,2)'="") G EN2^ENJINJ1
- ;
- S:'$D(DJDPL) DJDPL=""
- EN ;
- I $D(DJDN)=0 S:$D(DJKEY) DJNX=DJKEY
- S DJQ=0,DJP=0,DJMU=0 I DJDPL'=DJNM D ^ENJDPL G TK
- EN2 S V=DJF-.01 I '$D(DJDN),'$D(DJW) D FUNC^ENJINQ
- NXT S V=$O(DJJ($S($D(DJNX):DJNX-.001,1:V))) G LST:V="",TK:$P(DJJ(V),U,5)&($P(DJJ(V),U,3)=.01)&('$D(DJDN)),NXT:$P(DJJ(V),U,4)["C" I $P(DJJ(V),U,5),$P(DJJ(V),U,4)'["W" G NXT
- TK K DJNX S DJMU=0,@$P(DJJ(V),U,2),DJAT=$P(DJJ(V),U,3),DJ0=^DD(DJDD,DJAT,0),DJ4=$P(DJJ(V),U,4),DJ3=$P(DJJ(V),U,3) S:DJ4["M" DJMU=1 G LH:DJAT<0,NXT:DJAT=.001 X XY G EN2:'DJJ(V)
- I DJ4["W" W @DJLIN I '($D(DJDIS)!($P(DJJ(V),U,5))) D PRACTW G:$D(DJNX) NXT X DJCP S DA=DJDN,DR=DJ3,(DJDIC,DIE)=DIC D ^DIE S DIC=DJDIC D PSACTW D N^ENJINJ3 D:$D(Y) EN3^ENJINJ1 S DJSV=V D:$Y>23 N^ENJDPL S V=DJSV G NXT
- I DJ4["W" I $D(DJDIS)!($P(DJJ(V),U,5)=1) D WP^ENJINJ1 G NXT
- G:$D(DJDIS)&($D(DJDN)) LST I $D(^ENG(6910.9,DJN,1,$O(^ENG(6910.9,DJN,1,"A",V,0)),2)),^(2)'="" X DJCP X ^(2) S @$P(DJJ(V),U,2) X XY G:$D(DJNX) NXT
- I DJAT'=.01,$D(^ENG(6910.9,DJN,1,$O(^ENG(6910.9,DJN,1,"A",V,0)),3)),V(V)="" S V(V)=^(3),DIE=DIC,DA=DJDN,DR=DJAT_"///"_V(V) D ^DIE D EN3^ENJINJ1
- R D:'$D(DJNX) HL,Z^ENJINJ3 I X="",DJ4["R",DJAT'=.01,V(V)="" G Q1
- S DJXX=$E(X) I DJXX=U,X'?1"^" G TK:"Dd"[$E(X,2)&($P(DJJ,U,4)=""),TK:"Uu"[$E(X,2)&($P(DJJ,U,2)=""),LS1:("Dd"[$E(X,2)!("Uu"[$E(X,2)))&($D(DJDN)),LS:"Nn"[$E(X,2)&($D(DJDN)) I "Cc"[$E(X,2) D FUNC^ENJINQ G TK
- G T4:(DJSM!(DJXX="<")!(DJXX=">")!(X?1"^"))&($D(DJDN)),OUT:X=U&(DJAT=.01)&('$D(DJDN)),TK:X?1"^".A
- S:$D(DJSW1) DJDIS=1 K DJSW1 G:DJMU ^ENJMUL
- EN3 G T4:DJSM,OUT:X=""&(DJAT=.01)&('$D(DJDN)),OUT:X="^"&(DJAT=.01)&('$D(DJDN)),T1^ENJINJ1:X="" X XY S $P(DJDB," ",DJJ(V))=" " W DJDB K DJDB
- S DJXX=$E(X,1) G U:X?1"^"&(DJAT=.01),T4:DJXX="^"!(DJXX="<")!(DJXX=">"),K1^ENJINJ1:X?1"?".E&(DJAT[".01")&('$D(DJDN)),Q1:X?1"?".E
- I X["^" W *7 G TK
- I X="@" D:DJAT>0 ^ENJINK S:DJST>1&(DJAT=.01) ^TMP($J,"DJST",DJST-1,"KEY")="" G TK:X'="@",T3
- G ^ENJINJ1
- T3 S V(V)=$S(X="@":"",1:X)
- G:DJAT=.01&(V(V)="") Q G T4
- Q1 D ^ENJINQ S @$P(DJJ(V),U,2) X XY G R
- HL G H1:'$D(V(V)),H1:V(V)="",H2
- H1 X XY W @DJHIN X XY S $P(DJDB,".",DJJ(V))="." W DJDB,@DJLIN K DJDB X XY Q
- H2 X XY W @DJHIN X XY S V(V)=$S($D(Y(0,0)):Y(0,0),1:V(V)) W V(V) K Y(0,0) X XY Q
- LH I DJ4["R" X DJCL W @DJHIN X XY W "DATA REQUIRED",@DJLIN,*7 S @$P(DJJ(V),U,2) X XY G TK
- T4 G:'($D(DJDN)) TK S @$P(DJJ(V),U,2) X XY
- I '$D(V(V)) S $P(DJDB,".",DJJ(V))="." W @DJLIN,DJDB K DJDB G T5
- I V(V)="" S $P(DJDB,".",DJJ(V))="." W @DJLIN,DJDB K DJDB G T5
- U I V(V)'="" S @$P(DJJ(V),U,2) X XY W @DJHIN X XY S $P(DJDB," ",DJJ(V)-$L(V(V)))=" " W V(V) W:$D(DJDB) DJDB K DJDB
- T5 Q:X?1"^"&($P(DJJ,U,2)="")&('$D(DJDN)) G LS1:X?1"^",NX:X'?1"^".N
- S DJY=$P(X,U,2) I X?1"^".N,$D(DJJ(DJY)),'$P(DJJ(DJY),U,5),$P(DJJ(DJY),U,4)'["C" S V=DJY-.01 G NXT
- E X DJCL W *7,"Number is out of range or field is read only or computed." S V=V-.01 H 5 G NXT
- NX G NXT:X=">" I X="<" S DJ0=V G EN2:V<2 F V=-1:0 S V=$O(DJJ(V)) I $O(DJJ(V))=DJ0 G NX:DJ4["C" S V=V-.001 G NXT
- G Q1:X["^",NXT
- P G TK:$P(DJJ,U,2)="" S DJN=$P(DJJ,U,2) S:DJN'=+DJN DJN=$O(^ENG(6910.9,"B",DJN,0)) S DJFF=0 D REST D N^ENJDPL G EN2
- Q I $P(^ENG(6910.9,DJN,0),U,3)'="" F DJK=0:0 S (DJDPL,DJNM)=$P(^ENG(6910.9,DJN,0),U,3),DJN=$O(^ENG(6910.9,"B",DJNM,0)) Q:$P(^ENG(6910.9,DJN,0),U,3)=""
- K V,DJ0,DJAT,DJDN,DJ3,DJ4,DJQ I '$D(DJW1) D ^ENJDPL G EN2
- OUT K DJSV,DJ0,DJAT,DJK,DJDN,DJ3,V,DJJ,DJQ,DIC,DJDD,DX,DY,DJSM,DJDIC,DJKEY S DJFF=0 Q
- LST G ^ENJINJ2:$D(DJDIS) S X="D"
- LS X DJCL G Q:(X["N"!(X["n"))&(DJP=0) Q:(X["N"!(X["n"))&(DJP=1)
- LS1 G:X?1"^" OUT I "Dd"[$E(X,2)&($P(DJJ,U,4)]"")&($D(DJDN)) D SAVE S DJN=$P(DJJ,U,4) S DJN=$O(^ENG(6910.9,"B",DJN,0)) S DJFF=0 D N^ENJDPL Q:$D(DJY) S (DA,W(V))=DJDN D ^ENJC2 G EN2
- I "Dd"[$E(X,2)&($P(DJJ,U,4)="") S:$P(DJJ,U,2)'="" DJFF=0 G Q
- G:"Uu"[$E(X,2) P
- G TK
- E W *7 G LS
- KILL K DB Q
- SAVE S %X="V(",%Y="^TMP($J,""DJ"",DJN," D %XY^%RCR K V Q
- REST K V S %X="^TMP($J,""DJ"",DJN,",%Y="V(" D %XY^%RCR Q
- B S $P(DJDB," ",DJJ(V)-$L(V(V)))=" " Q
- D S $P(DJDB,".",DJJ(V))="." Q
- PRACTW ;Pre Action Code for Word Processing Field
- I $D(^ENG(6910.9,DJN,1,$O(^ENG(6910.9,DJN,1,"A",V,0)),2)),^(2)'="" X DJCP X ^(2)
- Q
- PSACTW ;Post Action Code for Word Processing Field
- I $D(^ENG(6910.9,DJN,1,$O(^ENG(6910.9,DJN,1,"A",V,0)),1)),^(1)'="" X DJCP X ^(1)
- Q
- ;ENJINJ
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENJINJ 4429 printed Feb 18, 2025@23:20:27 Page 2
- ENJINJ ;(WASH ISC)/JA/TJK-Screen Entry of Data ;1/8/2001
- +1 ;;7.0;ENGINEERING;**39,55,69**;Aug 17, 1993
- +2 KILL DJDN
- +3 IF '$DATA(DJDN)&($PIECE(DJJ,U,2)'="")
- GOTO EN2^ENJINJ1
- +4 ;
- +5 if '$DATA(DJDPL)
- SET DJDPL=""
- EN ;
- +1 IF $DATA(DJDN)=0
- if $DATA(DJKEY)
- SET DJNX=DJKEY
- +2 SET DJQ=0
- SET DJP=0
- SET DJMU=0
- IF DJDPL'=DJNM
- DO ^ENJDPL
- GOTO TK
- EN2 SET V=DJF-.01
- IF '$DATA(DJDN)
- IF '$DATA(DJW)
- DO FUNC^ENJINQ
- NXT SET V=$ORDER(DJJ($SELECT($DATA(DJNX):DJNX-.001,1:V)))
- if V=""
- GOTO LST
- if $PIECE(DJJ(V),U,5)&($PIECE(DJJ(V),U,3)=.01)&('$DATA(DJDN))
- GOTO TK
- if $PIECE(DJJ(V),U,4)["C"
- GOTO NXT
- IF $PIECE(DJJ(V),U,5)
- IF $PIECE(DJJ(V),U,4)'["W"
- GOTO NXT
- TK KILL DJNX
- SET DJMU=0
- SET @$PIECE(DJJ(V),U,2)
- SET DJAT=$PIECE(DJJ(V),U,3)
- SET DJ0=^DD(DJDD,DJAT,0)
- SET DJ4=$PIECE(DJJ(V),U,4)
- SET DJ3=$PIECE(DJJ(V),U,3)
- if DJ4["M"
- SET DJMU=1
- if DJAT<0
- GOTO LH
- if DJAT=.001
- GOTO NXT
- XECUTE XY
- if 'DJJ(V)
- GOTO EN2
- +1 IF DJ4["W"
- WRITE @DJLIN
- IF '($DATA(DJDIS)!($PIECE(DJJ(V),U,5)))
- DO PRACTW
- if $DATA(DJNX)
- GOTO NXT
- XECUTE DJCP
- SET DA=DJDN
- SET DR=DJ3
- SET (DJDIC,DIE)=DIC
- DO ^DIE
- SET DIC=DJDIC
- DO PSACTW
- DO N^ENJINJ3
- if $DATA(Y)
- DO EN3^ENJINJ1
- SET DJSV=V
- if $Y>23
- DO N^ENJDPL
- SET V=DJSV
- GOTO NXT
- +2 IF DJ4["W"
- IF $DATA(DJDIS)!($PIECE(DJJ(V),U,5)=1)
- DO WP^ENJINJ1
- GOTO NXT
- +3 if $DATA(DJDIS)&($DATA(DJDN))
- GOTO LST
- IF $DATA(^ENG(6910.9,DJN,1,$ORDER(^ENG(6910.9,DJN,1,"A",V,0)),2))
- IF ^(2)'=""
- XECUTE DJCP
- XECUTE ^(2)
- SET @$PIECE(DJJ(V),U,2)
- XECUTE XY
- if $DATA(DJNX)
- GOTO NXT
- +4 IF DJAT'=.01
- IF $DATA(^ENG(6910.9,DJN,1,$ORDER(^ENG(6910.9,DJN,1,"A",V,0)),3))
- IF V(V)=""
- SET V(V)=^(3)
- SET DIE=DIC
- SET DA=DJDN
- SET DR=DJAT_"///"_V(V)
- DO ^DIE
- DO EN3^ENJINJ1
- R if '$DATA(DJNX)
- DO HL
- DO Z^ENJINJ3
- IF X=""
- IF DJ4["R"
- IF DJAT'=.01
- IF V(V)=""
- GOTO Q1
- +1 SET DJXX=$EXTRACT(X)
- IF DJXX=U
- IF X'?1"^"
- if "Dd"[$EXTRACT(X,2)&($PIECE(DJJ,U,4)="")
- GOTO TK
- if "Uu"[$EXTRACT(X,2)&($PIECE(DJJ,U,2)="")
- GOTO TK
- if ("Dd"[$EXTRACT(X,2)!("Uu"[$EXTRACT(X,2)))&($DATA(DJDN))
- GOTO LS1
- if "Nn"[$EXTRACT(X,2)&($DATA(DJDN))
- GOTO LS
- IF "Cc"[$EXTRACT(X,2)
- DO FUNC^ENJINQ
- GOTO TK
- +2 if (DJSM!(DJXX="<")!(DJXX=">")!(X?1"^"))&($DATA(DJDN))
- GOTO T4
- if X=U&(DJAT=.01)&('$DATA(DJDN))
- GOTO OUT
- if X?1"^".A
- GOTO TK
- +3 if $DATA(DJSW1)
- SET DJDIS=1
- KILL DJSW1
- if DJMU
- GOTO ^ENJMUL
- EN3 if DJSM
- GOTO T4
- if X=""&(DJAT=.01)&('$DATA(DJDN))
- GOTO OUT
- if X="^"&(DJAT=.01)&('$DATA(DJDN))
- GOTO OUT
- if X=""
- GOTO T1^ENJINJ1
- XECUTE XY
- SET $PIECE(DJDB," ",DJJ(V))=" "
- WRITE DJDB
- KILL DJDB
- +1 SET DJXX=$EXTRACT(X,1)
- if X?1"^"&(DJAT=.01)
- GOTO U
- if DJXX="^"!(DJXX="<")!(DJXX=">")
- GOTO T4
- if X?1"?".E&(DJAT[".01")&('$DATA(DJDN))
- GOTO K1^ENJINJ1
- if X?1"?".E
- GOTO Q1
- +2 IF X["^"
- WRITE *7
- GOTO TK
- +3 IF X="@"
- if DJAT>0
- DO ^ENJINK
- if DJST>1&(DJAT=.01)
- SET ^TMP($JOB,"DJST",DJST-1,"KEY")=""
- if X'="@"
- GOTO TK
- GOTO T3
- +4 GOTO ^ENJINJ1
- T3 SET V(V)=$SELECT(X="@":"",1:X)
- +1 if DJAT=.01&(V(V)="")
- GOTO Q
- GOTO T4
- Q1 DO ^ENJINQ
- SET @$PIECE(DJJ(V),U,2)
- XECUTE XY
- GOTO R
- HL if '$DATA(V(V))
- GOTO H1
- if V(V)=""
- GOTO H1
- GOTO H2
- H1 XECUTE XY
- WRITE @DJHIN
- XECUTE XY
- SET $PIECE(DJDB,".",DJJ(V))="."
- WRITE DJDB,@DJLIN
- KILL DJDB
- XECUTE XY
- QUIT
- H2 XECUTE XY
- WRITE @DJHIN
- XECUTE XY
- SET V(V)=$SELECT($DATA(Y(0,0)):Y(0,0),1:V(V))
- WRITE V(V)
- KILL Y(0,0)
- XECUTE XY
- QUIT
- LH IF DJ4["R"
- XECUTE DJCL
- WRITE @DJHIN
- XECUTE XY
- WRITE "DATA REQUIRED",@DJLIN,*7
- SET @$PIECE(DJJ(V),U,2)
- XECUTE XY
- GOTO TK
- T4 if '($DATA(DJDN))
- GOTO TK
- SET @$PIECE(DJJ(V),U,2)
- XECUTE XY
- +1 IF '$DATA(V(V))
- SET $PIECE(DJDB,".",DJJ(V))="."
- WRITE @DJLIN,DJDB
- KILL DJDB
- GOTO T5
- +2 IF V(V)=""
- SET $PIECE(DJDB,".",DJJ(V))="."
- WRITE @DJLIN,DJDB
- KILL DJDB
- GOTO T5
- U IF V(V)'=""
- SET @$PIECE(DJJ(V),U,2)
- XECUTE XY
- WRITE @DJHIN
- XECUTE XY
- SET $PIECE(DJDB," ",DJJ(V)-$LENGTH(V(V)))=" "
- WRITE V(V)
- if $DATA(DJDB)
- WRITE DJDB
- KILL DJDB
- T5 if X?1"^"&($PIECE(DJJ,U,2)="")&('$DATA(DJDN))
- QUIT
- if X?1"^"
- GOTO LS1
- if X'?1"^".N
- GOTO NX
- +1 SET DJY=$PIECE(X,U,2)
- IF X?1"^".N
- IF $DATA(DJJ(DJY))
- IF '$PIECE(DJJ(DJY),U,5)
- IF $PIECE(DJJ(DJY),U,4)'["C"
- SET V=DJY-.01
- GOTO NXT
- +2 IF '$TEST
- XECUTE DJCL
- WRITE *7,"Number is out of range or field is read only or computed."
- SET V=V-.01
- HANG 5
- GOTO NXT
- NX if X=">"
- GOTO NXT
- IF X="<"
- SET DJ0=V
- if V<2
- GOTO EN2
- FOR V=-1:0
- SET V=$ORDER(DJJ(V))
- IF $ORDER(DJJ(V))=DJ0
- if DJ4["C"
- GOTO NX
- SET V=V-.001
- GOTO NXT
- +1 if X["^"
- GOTO Q1
- GOTO NXT
- P if $PIECE(DJJ,U,2)=""
- GOTO TK
- SET DJN=$PIECE(DJJ,U,2)
- if DJN'=+DJN
- SET DJN=$ORDER(^ENG(6910.9,"B",DJN,0))
- SET DJFF=0
- DO REST
- DO N^ENJDPL
- GOTO EN2
- Q IF $PIECE(^ENG(6910.9,DJN,0),U,3)'=""
- FOR DJK=0:0
- SET (DJDPL,DJNM)=$PIECE(^ENG(6910.9,DJN,0),U,3)
- SET DJN=$ORDER(^ENG(6910.9,"B",DJNM,0))
- if $PIECE(^ENG(6910.9,DJN,0),U,3)=""
- QUIT
- +1 KILL V,DJ0,DJAT,DJDN,DJ3,DJ4,DJQ
- IF '$DATA(DJW1)
- DO ^ENJDPL
- GOTO EN2
- OUT KILL DJSV,DJ0,DJAT,DJK,DJDN,DJ3,V,DJJ,DJQ,DIC,DJDD,DX,DY,DJSM,DJDIC,DJKEY
- SET DJFF=0
- QUIT
- LST if $DATA(DJDIS)
- GOTO ^ENJINJ2
- SET X="D"
- LS XECUTE DJCL
- if (X["N"!(X["n"))&(DJP=0)
- GOTO Q
- if (X["N"!(X["n"))&(DJP=1)
- QUIT
- LS1 if X?1"^"
- GOTO OUT
- IF "Dd"[$EXTRACT(X,2)&($PIECE(DJJ,U,4)]"")&($DATA(DJDN))
- DO SAVE
- SET DJN=$PIECE(DJJ,U,4)
- SET DJN=$ORDER(^ENG(6910.9,"B",DJN,0))
- SET DJFF=0
- DO N^ENJDPL
- if $DATA(DJY)
- QUIT
- SET (DA,W(V))=DJDN
- DO ^ENJC2
- GOTO EN2
- +1 IF "Dd"[$EXTRACT(X,2)&($PIECE(DJJ,U,4)="")
- if $PIECE(DJJ,U,2)'=""
- SET DJFF=0
- GOTO Q
- +2 if "Uu"[$EXTRACT(X,2)
- GOTO P
- +3 GOTO TK
- +4 IF '$TEST
- WRITE *7
- GOTO LS
- KILL KILL DB
- QUIT
- SAVE SET %X="V("
- SET %Y="^TMP($J,""DJ"",DJN,"
- DO %XY^%RCR
- KILL V
- QUIT
- REST KILL V
- SET %X="^TMP($J,""DJ"",DJN,"
- SET %Y="V("
- DO %XY^%RCR
- QUIT
- B SET $PIECE(DJDB," ",DJJ(V)-$LENGTH(V(V)))=" "
- QUIT
- D SET $PIECE(DJDB,".",DJJ(V))="."
- QUIT
- PRACTW ;Pre Action Code for Word Processing Field
- +1 IF $DATA(^ENG(6910.9,DJN,1,$ORDER(^ENG(6910.9,DJN,1,"A",V,0)),2))
- IF ^(2)'=""
- XECUTE DJCP
- XECUTE ^(2)
- +2 QUIT
- PSACTW ;Post Action Code for Word Processing Field
- +1 IF $DATA(^ENG(6910.9,DJN,1,$ORDER(^ENG(6910.9,DJN,1,"A",V,0)),1))
- IF ^(1)'=""
- XECUTE DJCP
- XECUTE ^(1)
- +2 QUIT
- +3 ;ENJINJ