DENTDML ;WASH ISC/TJK,JA,NCA-MULTIPLE STACK DRIVER ;6/29/92 14:37
;;1.2;DENTAL;**15,23**;Oct 08, 1992
; invoked by paragraph R^DENTDNJ (user input handler)
K DJW2,DJK1 G EN3^DENTDNJ:X?1"^".N,TK^DENTDNJ:X=""!($E(X,1)="^") S:X="@" DJK1=1 S:X=" "!(X="@") X=V(V)
S DJST=DJST+1,^TMP($J,"DJST",DJST,"DA")=V(V,"DA")
S YMLH=$O(^DENT(220.6,"B",$P(DJJ(V),U,6),0)) S:YMLH="" YMLH=-1
S ^TMP($J,"DJST",DJST,"SC")=YMLH,^TMP($J,"DJST",DJST-1,"LOC")=V,^TMP($J,"DJST",DJST,"DD")=V(V,"DD"),^TMP($J,"DJST",DJST,"GN")=V(V,"GN")
S ^TMP($J,"DJST",DJST,"FRSC")=DJN,^TMP($J,"DJST",DJST,"DIC")=^TMP($J,"DJST",DJST-1,"DIC")_^TMP($J,"DJST",DJST-1,"DA")_","_V(V,"GN")_","
S DJZ=DJST F DJK=1:1:DJST-1 S DJZ=DJZ-1,DA(DJZ)=^TMP($J,"DJST",DJK,"DA")
S DJNM=$P(^DENT(220.6,^TMP($J,"DJST",DJST,"SC"),0),U,1),DIC=^TMP($J,"DJST",DJST,"DIC") S:$D(@(DIC_0_")"))=0 @(DIC_0_")")="^"_^TMP($J,"DJST",DJST,"DD")_"^^" K DJDN
S DIC(0)="EQZM" S:'$D(DJDIS) DIC(0)=DIC(0)_"L" X DJCP D ^DENTDC G D:$D(DJK1) I X["?" X DJCL S:DJ4["S" DJT=DJDD,DJDD=+DJ4,DJY=DJAT,DJAT=.01 D ^DENTDNQ:DJ4["S"!(DJ4["D") S:DJ4["S" DJDD=DJT,DJAT=DJY
I Y>0,$P(DJJ(V),U,7)=1 S V(V)=X S @$P(DJJ(V),U,2) X XY W DJHIN X XY S DJDB="" S:(DJJ(V)-$L(V(V))) $P(DJDB," ",DJJ(V)-$L(V(V)))=" " W V(V),DJDB,DJLIN K DJDB G A
I $Y>23 R !,"Press <RETURN> to Continue",DJZ1:DTIME K DJZ1
I Y>0 D SAVE K V,DJMUL S DA=+Y,DJDN=+Y,^TMP($J,"DJST",DJST,"DA")=DA,@("D"_(DJST-1)_"="_DA) D ^DENTDPL,FUNC^DENTDNQ2 S (W(V),V(V))=DJDN D ^DENTD1 S ^TMP($J,"DJST",DJST-1,"KEY")=V(DJKEY) D EN^DENTDNJ S DJW2=1
A S DJN=^TMP($J,"DJST",DJST,"FRSC") S DJST=DJST-1 S DJNM=$P(^DENT(220.6,DJN,0),"^",1),DIC=^TMP($J,"DJST",DJST,"DIC") S DJDN=^TMP($J,"DJST",DJST,"DA")
K DA S DJZ=DJST I $D(DJW2),DJST>1 F DJK=1:1:DJST-1 S DJZ=DJZ-1,DA(DJZ)=^TMP($J,"DJST",DJK,"DA")
I $D(DJW2),DJST>1 F DJK=0:1:DJST-2 S @("D"_DJK)=^TMP($J,"DJST",DJK+1,"DA")
I $D(DJW2) D REST S V=^TMP($J,"DJST",DJST,"LOC"),V(V)=^TMP($J,"DJST",DJST,"KEY") D ^DENTDPL,FUNC^DENTDNQ2 K DJZ,DJW2 G N
N S DJFF=0,V=^TMP($J,"DJST",DJST,"LOC") G TK^DENTDNJ
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
D G:Y<0 D1 I Y>0 X DJCL S DY=22,DX=0 X XY W DJEOP W !,"ARE YOU SURE YOU WANT TO DELETE: NO// ",*7 R DJX:DTIME
I DJX["?" W "ANSWER YES OR NO -- RETURN TO CONTINUE" R DJX:DTIME G D
G:DJX'["Y" D1 S DA=+Y,DR=".01///@" S DIE=DIC D ^DIE K DJK1 S V(V)="" G A
D1 X DJCL W "NOTHING DELETED" G A
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTDML 2444 printed Oct 16, 2024@17:47:14 Page 2
DENTDML ;WASH ISC/TJK,JA,NCA-MULTIPLE STACK DRIVER ;6/29/92 14:37
+1 ;;1.2;DENTAL;**15,23**;Oct 08, 1992
+2 ; invoked by paragraph R^DENTDNJ (user input handler)
+3 KILL DJW2,DJK1
if X?1"^".N
GOTO EN3^DENTDNJ
if X=""!($EXTRACT(X,1)="^")
GOTO TK^DENTDNJ
if X="@"
SET DJK1=1
if X=" "!(X="@")
SET X=V(V)
+4 SET DJST=DJST+1
SET ^TMP($JOB,"DJST",DJST,"DA")=V(V,"DA")
+5 SET YMLH=$ORDER(^DENT(220.6,"B",$PIECE(DJJ(V),U,6),0))
if YMLH=""
SET YMLH=-1
+6 SET ^TMP($JOB,"DJST",DJST,"SC")=YMLH
SET ^TMP($JOB,"DJST",DJST-1,"LOC")=V
SET ^TMP($JOB,"DJST",DJST,"DD")=V(V,"DD")
SET ^TMP($JOB,"DJST",DJST,"GN")=V(V,"GN")
+7 SET ^TMP($JOB,"DJST",DJST,"FRSC")=DJN
SET ^TMP($JOB,"DJST",DJST,"DIC")=^TMP($JOB,"DJST",DJST-1,"DIC")_^TMP($JOB,"DJST",DJST-1,"DA")_","_V(V,"GN")_","
+8 SET DJZ=DJST
FOR DJK=1:1:DJST-1
SET DJZ=DJZ-1
SET DA(DJZ)=^TMP($JOB,"DJST",DJK,"DA")
+9 SET DJNM=$PIECE(^DENT(220.6,^TMP($JOB,"DJST",DJST,"SC"),0),U,1)
SET DIC=^TMP($JOB,"DJST",DJST,"DIC")
if $DATA(@(DIC_0_")"))=0
SET @(DIC_0_")")="^"_^TMP($JOB,"DJST",DJST,"DD")_"^^"
KILL DJDN
+10 SET DIC(0)="EQZM"
if '$DATA(DJDIS)
SET DIC(0)=DIC(0)_"L"
XECUTE DJCP
DO ^DENTDC
if $DATA(DJK1)
GOTO D
IF X["?"
XECUTE DJCL
if DJ4["S"
SET DJT=DJDD
SET DJDD=+DJ4
SET DJY=DJAT
SET DJAT=.01
if DJ4["S"!(DJ4["D")
DO ^DENTDNQ
if DJ4["S"
SET DJDD=DJT
SET DJAT=DJY
+11 IF Y>0
IF $PIECE(DJJ(V),U,7)=1
SET V(V)=X
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
WRITE DJHIN
XECUTE XY
SET DJDB=""
if (DJJ(V)-$LENGTH(V(V)))
SET $PIECE(DJDB," ",DJJ(V)-$LENGTH(V(V)))=" "
WRITE V(V),DJDB,DJLIN
KILL DJDB
GOTO A
+12 IF $Y>23
READ !,"Press <RETURN> to Continue",DJZ1:DTIME
KILL DJZ1
+13 IF Y>0
DO SAVE
KILL V,DJMUL
SET DA=+Y
SET DJDN=+Y
SET ^TMP($JOB,"DJST",DJST,"DA")=DA
SET @("D"_(DJST-1)_"="_DA)
DO ^DENTDPL
DO FUNC^DENTDNQ2
SET (W(V),V(V))=DJDN
DO ^DENTD1
SET ^TMP($JOB,"DJST",DJST-1,"KEY")=V(DJKEY)
DO EN^DENTDNJ
SET DJW2=1
A SET DJN=^TMP($JOB,"DJST",DJST,"FRSC")
SET DJST=DJST-1
SET DJNM=$PIECE(^DENT(220.6,DJN,0),"^",1)
SET DIC=^TMP($JOB,"DJST",DJST,"DIC")
SET DJDN=^TMP($JOB,"DJST",DJST,"DA")
+1 KILL DA
SET DJZ=DJST
IF $DATA(DJW2)
IF DJST>1
FOR DJK=1:1:DJST-1
SET DJZ=DJZ-1
SET DA(DJZ)=^TMP($JOB,"DJST",DJK,"DA")
+2 IF $DATA(DJW2)
IF DJST>1
FOR DJK=0:1:DJST-2
SET @("D"_DJK)=^TMP($JOB,"DJST",DJK+1,"DA")
+3 IF $DATA(DJW2)
DO REST
SET V=^TMP($JOB,"DJST",DJST,"LOC")
SET V(V)=^TMP($JOB,"DJST",DJST,"KEY")
DO ^DENTDPL
DO FUNC^DENTDNQ2
KILL DJZ,DJW2
GOTO N
N SET DJFF=0
SET V=^TMP($JOB,"DJST",DJST,"LOC")
GOTO TK^DENTDNJ
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
D if Y<0
GOTO D1
IF Y>0
XECUTE DJCL
SET DY=22
SET DX=0
XECUTE XY
WRITE DJEOP
WRITE !,"ARE YOU SURE YOU WANT TO DELETE: NO// ",*7
READ DJX:DTIME
+1 IF DJX["?"
WRITE "ANSWER YES OR NO -- RETURN TO CONTINUE"
READ DJX:DTIME
GOTO D
+2 if DJX'["Y"
GOTO D1
SET DA=+Y
SET DR=".01///@"
SET DIE=DIC
DO ^DIE
KILL DJK1
SET V(V)=""
GOTO A
D1 XECUTE DJCL
WRITE "NOTHING DELETED"
GOTO A
