source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTDNK.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1DENTDNK ;WASH ISC/TJK,JA,NCA-SCREEN INPUT-KILLS (@) ;09/29/87 11:22 AM;12/03/91 3:26 PM
2 ;;1.2;DENTAL;**15,23**;Oct 08, 1992
3 I V(V)="" S X="" X DJCL W "No data entered",*7 Q
4 I V(V)'="" S @$P(DJJ(V),U,2) X XY W DJHIN X XY W V(V),DJLIN
5 ;I '$D(^DIC(DJDD,0,"DEL")) G KILL
6 ;I DUZ(0)["@" G KILL
7 ;I $D(^DD(DJDD,0,"DEL")),DUZ(0)[^DD(DJDD,0,"DEL") G KILL
8 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")
9 X DJCL W *7,DJHIN,"NOT ALLOWED TO DELETE",DJLIN S X=V(V) G HALT
10KILL 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
11ILL I DJ4["R",$P(DJJ(V),U,3)'=.01 X DJCL W *7,DJHIN,"REQUIRED <NOTHING DELETED>",DJLIN S X=V(V) G HALT
12 G N:$P(DJJ(V),U,3)'=.01
13ILL1 X DJCL S DY=22,DX=0 X XY W DJEOP W *7,"SURE YOU WANT TO DELETE?: NO//" R X:DTIME
14 I X["?" D HELP G ILL1
15 I X["Y" X DJCP S DY=22,DX=0 X XY W DJEOP S DIE=DIC,DR=".01///@" D ^DIE G:'$D(DA) K S X=V(V) G HALT
16 S X=V(V) G HALT
17N X DJCP X DJCL
18N1 S DY=22,DX=0 X XY W DJEOP
19 W *7,"SURE YOU WANT TO DELETE?: NO//" R X:DTIME I X["Y" 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:"@") D FUNC^DENTDNQ2 Q
20 I X["?" D HELP G N1
21 S X=V(V) D FUNC^DENTDNQ2 Q
22NXT 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
23 K DJDN Q
24K I DJDPL'="DJ.DEF2" K V S V=0 G K1
25 S V=5.9 F DJK=6:1:25 K V(DJK)
26K1 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
27 S V=0,X="@" K DJDN,DJK Q
28HALT S YMLH=$O(^DENT(220.6,DJN,1,"A",V,0)) S:YMLH="" YMLH=-1 I $D(^DENT(220.6,DJN,1,YMLH,2)) R " Press <RETURN> to Continue",DJX:DTIME D FUNC^DENTDNQ2 Q
29 Q
30HELP X DJCL W *7,"ANSWER 'YES' OR 'NO'--- RETURN TO CONTINUE " R X:DTIME Q
Note: See TracBrowser for help on using the repository browser.