source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTDNQ.m@ 701

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DENTDNQ ;WASH ISC/TJK,JA,NCA-SCREEN INPUT-QUESTIONMARKS ;8/28/92 09:08
2 ;;1.2;DENTAL;**15,23**;NOV 1993
3 S D=""
4A S DJX="" X DJCP
5 I DJ4["R" W "**REQUIRED**",*7
6 S:'$D(X) X=DJXX G:X'="??" F G:'$D(^DD(DJDD,DJAT,21,0)) F G:'$P(^(0),U,4) F
7 S DJZ1=0,DIWL=1,DIWR=79,DIWF="" K ^UTILITY($J,"W")
8 S DJXX=X F DJK=1:1 S DJZ1=$O(^DD(DJDD,DJAT,21,DJZ1)) Q:DJZ1="" S X=^(DJZ1,0) D ^DIWP
9 D ^DIWW ; purge WP buffer
10 S DJZ1=0 F DJK=1:1 S DJZ1=$O(^UTILITY($J,"W",DIWL,DJZ1)) Q:DJZ1="" D:$Y>21 CONT Q:DJX[U W !,^(DJZ1,0)
11 K DJZ1,DJK,^UTILITY($J,"W",DIWL),DIWL,DIWR,DIWF S X=DJXX G:DJX'[U F Q
12CONT W !,"Press <RETURN> to Continue, '^' to Quit: " R DJX:DTIME
13 I $Y>22 S DJSV=V D N^DENTDPL S V=DJSV
14 X DJCP W !
15 Q
16F D:$Y>21 CONT I DJX[U D FUNC^DENTDNQ2 Q
17 D:$D(^DD(DJDD,DJAT,3)) DEDJHELP I $D(^DD(DJDD,DJAT,4)) W ! X ^(4)
18 I DJ4["S",DJ4'["M" D:$Y>21 CONT G:DJX[U END D D FUNC^DENTDNQ2
19 .W !,"CHOOSE FROM:" S DJS=$P(^DD(DJDD,DJAT,0),U,3)
20 .F DJK=1:1 S Y=$P(DJS,";",DJK) Q:Y="" D
21 ..S Y="'"_$P(Y,":",1)_"' FOR "_$P(Y,":",2)
22 ..D:$Y>21 CONT Q:DJX[U
23 ..W !,Y Q
24 .D CONT Q
25 D DCS
26 I DJ4["P" K DIC("S") S DJDIC=DIC,DJD0=D0,DIC(0)=$S(DJ4["'":"MEQZ",1:"MEQZL"),DIC=+$P(DJ4,"P",2) D:$Y>21 CONT X:$P(^DD(DJDD,DJAT,0),U,2)["*" ^(12.1) D ^DENTDC K DIC S DIC=DJDIC,D0=DJD0 G:Y<0 R1 S V(V)=$P(Y,U,2) G P1
27 I DJ4["D" S:'$D(%DT) %DT="E" D HELP
28 I DJ4["N" D FUNC^DENTDNQ2
29 K DJS,DJZ1 I $Y>23 X DJCL R "Press <RETURN> to Continue",X:DTIME S DJZ=V D N^DENTDPL S V=DJZ Q
30 S @$P(DJJ(V),U,2) X XY W V(V) Q
31P D DCS
32 K DIC("S") S DJDIC=DIC,DJD0=D0,DIC(0)=$S(DJ4["'":"MEQZ",1:"MEQZL"),DIC=+$P(DJ4,"P",2) X DJCP X:$P(^DD(DJDD,DJAT,0),U,2)["*" ^(12.1) D ^DENTDC K DIC S:+Y>0 V(V)=$E($P(Y,U,2),1,+DJJ(V)),DIC=DJDIC,D0=DJD0 G:Y<0 R1
33P1 S X=+Y,V(V)=$E($P(Y,U,2),1,+DJJ(V)),(DIE,DIC)=DJDIC,DA=DJDN,DR=DJ3_"////"_X X DJCP W ! D ^DIE S D0=DJD0 K DJD0 D PP S V(V)=$E(V(V),1,+DJJ(V))
34 S YMLH=$O(^DENT(697.3,DJN,1,"A",V,0)) S:YMLH="" YMLH=-1
35 X:$D(^DENT(697.3,DJN,1,YMLH,1)) ^(1)
36 I $Y>23 S DJZ=V D N^DENTDPL S V=DJZ Q
37 S DY=17,DX=0 X XY W DJEOP S @$P(DJJ(V),U,2) X XY W DJHIN X XY W V(V),DJLIN D FUNC^DENTDNQ2 Q
38END ; Exit and Display Commands
39 D FUNC^DENTDNQ2 Q
40R1 K DJD0 S DIC=DJDIC
41 S @$P(DJJ(V),U,2) X XY W:$D(V(V)) DJHIN W:$D(V(V)) V(V) X XY D FUNC^DENTDNQ2 Q
42HELP D:$Y>21 R W !,"EXAMPLES OF VALID DATES:"
43 D:$Y>21 R W !," JAN 22 1957 or 22 JAN 57 or 1/22/57 or 012257"
44 D:$Y>21 R W !," T (FOR TODAY), T+1 (FOR TOMORROW), T+2, T+7, etc."," T-1 (FOR YESTERDAY)"
45 D:$Y>21 R W !," T-3W (3 WEEKS AGO), etc."
46 D:$Y>21 R W !,"IF THE YEAR IS OMITTED, THE COMPUTER USES THE CURRENT YEAR",!
47 D:$Y>21 R I %DT'["X" W "YOU MAY OMIT THE PRECISE DAY, AS: JAN, 1957",!
48 D:$Y>21 R I %DT["T" W "FOLLOW DATE WITH TIME, AS: JAN 22@10, T@10PM, ETC."
49 Q
50R X DJCL W "Press <RETURN> to Continue" R DJX:10 X DJCP
51PP S DJZ=+$P($P(^DD(DJDD,DJAT,0),"^",2),"P",2) Q:$P(^DD(DJZ,.01,0),"^",2)'["P"
52P11 I $D(@("^"_$P(^DD(DJZ,.01,0),U,3)_"V(V),0)")) S V(V)=$P(^(0),U,1)
53 S DJZ=+$P($P(^DD(DJZ,.01,0),"^",2),"P",2) Q:$P(^DD(DJZ,.01,0),"^",2)'["P" G P11
54DCS S DJNODE=.01 Q:DJ4'["P"
55 S DJ44=$S(DJ4'["'":DJ4,1:$P(DJ4,"P",2))
56 Q:'$D(^DD(+DJ44,0,"UP")) I $D(^DD(^DD(+DJ44,0,"UP"),0,"UP")) S DJ44=^DD(+DJ44,0,"UP"),DJNODE=$P(DJJ(V),U,3)
57 I DJNODE=.01,$D(^DD(DJDD,DJ3,12.1)) X ^(12.1) G DCS1
58 K DIC("S") Q:'$D(^DD(+DJ44,DJNODE)) S:'$D(DIC(0)) DIC(0)=""
59 I $D(^DD(+DJ44,DJNODE,12.1)) X ^(12.1)
60 E K DJNODE,DJ44 Q
61DCS1 S:'$D(DIC(0)) DIC(0)="" K:DIC(0)'="" DIC("S") K DJNODE,DJ44 Q
62DEDJHELP ;
63 S DECNT=0,DEDJHELP(1)=^DD(DJDD,DJAT,3)
64 D DEDJHEL1
65 R !,"Press <RETURN> to Continue: ",DEXRET:DTIME
66 X DJCP
67 K DEDJHELP,DECNT,DEXRET
68 Q
69DEDJHEL1 ;
70 S DECNT=DECNT+1
71 Q:'$D(DEDJHELP(DECNT))
72 F I=79:-1:1 Q:$E(DEDJHELP(DECNT),I)=" "
73 I $L(DEDJHELP(DECNT))>79 S DEDJHELP(DECNT+1)=$E(DEDJHELP(DECNT),I+1,$L(DEDJHELP(DECNT))),DEDJHELP(DECNT)=$E(DEDJHELP(DECNT),1,I-1)
74 W !,DEDJHELP(DECNT)
75 G DEDJHEL1
Note: See TracBrowser for help on using the repository browser.