MCARDNK ;WISC/TJK,JA-SCREEN INPUT - KILLS (@) ;5/2/96 12:58
;;2.3;Medicine;;09/13/1996
I V(V)="" S X="" X DJCL W "No data entered",*7 Q
I V(V)'="" S @$P(DJJ(V),U,2) X XY W DJHIN X XY W V(V),DJLIN
;I '$D(^DIC(DJDD,0,"DEL")) G KILL
;I DUZ(0)["@" G KILL
;I $D(^DD(DJDD,0,"DEL")),DUZ(0)[^DD(DJDD,0,"DEL") G KILL
G KILL:$P(DJJ(V),U,3)'=.01,KILL:'$D(^DIC(DJDD,0,"DEL")) G KILL:DUZ(0)="@" I $D(^DIC(DJDD,0,"DEL")) G KILL:DUZ(0)[^("DEL")
X DJCL W *7,DJHIN,"NOT ALLOWED TO DELETE",DJLIN S X=V(V) G HALT
KILL I $D(^DD(DJDD,DJAT,8.5)),DUZ(0)'[^(8.5),DUZ(0)'="@" X DJCL W *7,DJHIN,"NOT ALLOWED TO DELETE",DJLIN S X=V(V) G HALT
ILL I DJ4["R",$P(DJJ(V),U,3)'=.01 X DJCL W *7,DJHIN,"REQUIRED <NOTHING DELETED>",DJLIN S X=V(V) G HALT
G N:$P(DJJ(V),U,3)'=.01
ILL1 X DJCL S DY=22,DX=0 X XY W DJEOP W *7,"SURE YOU WANT TO DELETE?: NO//" R X:DTIME
I X["?" D HELP G ILL1
I X["Y" X DJCP S DY=22,DX=0 X XY W DJEOP S DIE=DIC,DA=DJDN,DR=".01///@" D ^DIE G:'$D(DA) K S X=V(V) G HALT
S X=V(V) G HALT
N X DJCP X DJCL
N1 S DY=22,DX=0 X XY W DJEOP
W *7,"SURE YOU WANT TO DELETE?: NO//" R X:DTIME S:$G(X)="" X="N"
I "Yy"[$G(X) X DJCP S DY=22,DX=0 X XY W DJEOP S DIE=DIC,DR=DJAT_"///@" D ^DIE S X=$S(X'="":V(V),1:"@") Q
I X["?" D HELP G N1
S X=V(V) Q
NXT S DJNN=$O(^DD(DJDD,DJAT,DJNN)) S:DJNN="" DJNN=-1 Q:DJNN<0 I $D(^(DJNN,2)) S X=V(V) X ^(2) S X="@" G NXT
K DJDN Q
K I DJDPL'="DJ.DEF2" K V S V=0 G K1
S V=5.9 F DJK=6:1:25 K V(DJK)
K1 F DJK=0:0 S V=$O(DJJ(V)) Q:V="" S @$P(DJJ(V),U,2) X XY S $P(DJDB,".",DJJ(V))="." W DJDB K DJDB
S V=0,X="@" K DJDN,DJK Q
HALT S YMLH=$O(^MCAR(697.3,DJN,1,"A",V,0)) S:YMLH="" YMLH=-1 I $D(^MCAR(697.3,DJN,1,YMLH,2)) R " Press <RETURN> to Continue",DJX:DTIME Q
Q
HELP X DJCL W *7,"ANSWER 'YES' OR 'NO'--- RETURN TO CONTINUE " R X:DTIME Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARDNK 1793 printed Nov 22, 2024@17:22:42 Page 2
MCARDNK ;WISC/TJK,JA-SCREEN INPUT - KILLS (@) ;5/2/96 12:58
+1 ;;2.3;Medicine;;09/13/1996
+2 IF V(V)=""
SET X=""
XECUTE DJCL
WRITE "No data entered",*7
QUIT
+3 IF V(V)'=""
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
WRITE DJHIN
XECUTE XY
WRITE V(V),DJLIN
+4 ;I '$D(^DIC(DJDD,0,"DEL")) G KILL
+5 ;I DUZ(0)["@" G KILL
+6 ;I $D(^DD(DJDD,0,"DEL")),DUZ(0)[^DD(DJDD,0,"DEL") G KILL
+7 if $PIECE(DJJ(V),U,3)'=.01
GOTO KILL
if '$DATA(^DIC(DJDD,0,"DEL"))
GOTO KILL
if DUZ(0)="@"
GOTO KILL
IF $DATA(^DIC(DJDD,0,"DEL"))
if DUZ(0)[^("DEL")
GOTO KILL
+8 XECUTE DJCL
WRITE *7,DJHIN,"NOT ALLOWED TO DELETE",DJLIN
SET X=V(V)
GOTO HALT
KILL IF $DATA(^DD(DJDD,DJAT,8.5))
IF DUZ(0)'[^(8.5)
IF DUZ(0)'="@"
XECUTE DJCL
WRITE *7,DJHIN,"NOT ALLOWED TO DELETE",DJLIN
SET X=V(V)
GOTO HALT
ILL IF DJ4["R"
IF $PIECE(DJJ(V),U,3)'=.01
XECUTE DJCL
WRITE *7,DJHIN,"REQUIRED <NOTHING DELETED>",DJLIN
SET X=V(V)
GOTO HALT
+1 if $PIECE(DJJ(V),U,3)'=.01
GOTO N
ILL1 XECUTE DJCL
SET DY=22
SET DX=0
XECUTE XY
WRITE DJEOP
WRITE *7,"SURE YOU WANT TO DELETE?: NO//"
READ X:DTIME
+1 IF X["?"
DO HELP
GOTO ILL1
+2 IF X["Y"
XECUTE DJCP
SET DY=22
SET DX=0
XECUTE XY
WRITE DJEOP
SET DIE=DIC
SET DA=DJDN
SET DR=".01///@"
DO ^DIE
if '$DATA(DA)
GOTO K
SET X=V(V)
GOTO HALT
+3 SET X=V(V)
GOTO HALT
N XECUTE DJCP
XECUTE DJCL
N1 SET DY=22
SET DX=0
XECUTE XY
WRITE DJEOP
+1 WRITE *7,"SURE YOU WANT TO DELETE?: NO//"
READ X:DTIME
if $GET(X)=""
SET X="N"
+2 IF "Yy"[$GET(X)
XECUTE DJCP
SET DY=22
SET DX=0
XECUTE XY
WRITE DJEOP
SET DIE=DIC
SET DR=DJAT_"///@"
DO ^DIE
SET X=$SELECT(X'="":V(V),1:"@")
QUIT
+3 IF X["?"
DO HELP
GOTO N1
+4 SET X=V(V)
QUIT
NXT SET DJNN=$ORDER(^DD(DJDD,DJAT,DJNN))
if DJNN=""
SET DJNN=-1
if DJNN<0
QUIT
IF $DATA(^(DJNN,2))
SET X=V(V)
XECUTE ^(2)
SET X="@"
GOTO NXT
+1 KILL DJDN
QUIT
K IF DJDPL'="DJ.DEF2"
KILL V
SET V=0
GOTO K1
+1 SET V=5.9
FOR DJK=6:1:25
KILL V(DJK)
K1 FOR DJK=0:0
SET V=$ORDER(DJJ(V))
if V=""
QUIT
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
SET $PIECE(DJDB,".",DJJ(V))="."
WRITE DJDB
KILL DJDB
+1 SET V=0
SET X="@"
KILL DJDN,DJK
QUIT
HALT SET YMLH=$ORDER(^MCAR(697.3,DJN,1,"A",V,0))
if YMLH=""
SET YMLH=-1
IF $DATA(^MCAR(697.3,DJN,1,YMLH,2))
READ " Press <RETURN> to Continue",DJX:DTIME
QUIT
+1 QUIT
HELP XECUTE DJCL
WRITE *7,"ANSWER 'YES' OR 'NO'--- RETURN TO CONTINUE "
READ X:DTIME
QUIT
