DENTDNQ ;WASH ISC/TJK,JA,NCA-SCREEN INPUT-QUESTIONMARKS ;8/28/92 09:08
;;1.2;DENTAL;**15,23**;NOV 1993
S D=""
A S DJX="" X DJCP
I DJ4["R" W "**REQUIRED**",*7
S:'$D(X) X=DJXX G:X'="??" F G:'$D(^DD(DJDD,DJAT,21,0)) F G:'$P(^(0),U,4) F
S DJZ1=0,DIWL=1,DIWR=79,DIWF="" K ^UTILITY($J,"W")
S DJXX=X F DJK=1:1 S DJZ1=$O(^DD(DJDD,DJAT,21,DJZ1)) Q:DJZ1="" S X=^(DJZ1,0) D ^DIWP
D ^DIWW ; purge WP buffer
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)
K DJZ1,DJK,^UTILITY($J,"W",DIWL),DIWL,DIWR,DIWF S X=DJXX G:DJX'[U F Q
CONT W !,"Press <RETURN> to Continue, '^' to Quit: " R DJX:DTIME
I $Y>22 S DJSV=V D N^DENTDPL S V=DJSV
X DJCP W !
Q
F D:$Y>21 CONT I DJX[U D FUNC^DENTDNQ2 Q
D:$D(^DD(DJDD,DJAT,3)) DEDJHELP I $D(^DD(DJDD,DJAT,4)) W ! X ^(4)
I DJ4["S",DJ4'["M" D:$Y>21 CONT G:DJX[U END D D FUNC^DENTDNQ2
.W !,"CHOOSE FROM:" S DJS=$P(^DD(DJDD,DJAT,0),U,3)
.F DJK=1:1 S Y=$P(DJS,";",DJK) Q:Y="" D
..S Y="'"_$P(Y,":",1)_"' FOR "_$P(Y,":",2)
..D:$Y>21 CONT Q:DJX[U
..W !,Y Q
.D CONT Q
D DCS
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
I DJ4["D" S:'$D(%DT) %DT="E" D HELP
I DJ4["N" D FUNC^DENTDNQ2
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
S @$P(DJJ(V),U,2) X XY W V(V) Q
P D DCS
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
P1 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))
S YMLH=$O(^DENT(697.3,DJN,1,"A",V,0)) S:YMLH="" YMLH=-1
X:$D(^DENT(697.3,DJN,1,YMLH,1)) ^(1)
I $Y>23 S DJZ=V D N^DENTDPL S V=DJZ Q
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
END ; Exit and Display Commands
D FUNC^DENTDNQ2 Q
R1 K DJD0 S DIC=DJDIC
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
HELP D:$Y>21 R W !,"EXAMPLES OF VALID DATES:"
D:$Y>21 R W !," JAN 22 1957 or 22 JAN 57 or 1/22/57 or 012257"
D:$Y>21 R W !," T (FOR TODAY), T+1 (FOR TOMORROW), T+2, T+7, etc."," T-1 (FOR YESTERDAY)"
D:$Y>21 R W !," T-3W (3 WEEKS AGO), etc."
D:$Y>21 R W !,"IF THE YEAR IS OMITTED, THE COMPUTER USES THE CURRENT YEAR",!
D:$Y>21 R I %DT'["X" W "YOU MAY OMIT THE PRECISE DAY, AS: JAN, 1957",!
D:$Y>21 R I %DT["T" W "FOLLOW DATE WITH TIME, AS: JAN 22@10, T@10PM, ETC."
Q
R X DJCL W "Press <RETURN> to Continue" R DJX:10 X DJCP
PP S DJZ=+$P($P(^DD(DJDD,DJAT,0),"^",2),"P",2) Q:$P(^DD(DJZ,.01,0),"^",2)'["P"
P11 I $D(@("^"_$P(^DD(DJZ,.01,0),U,3)_"V(V),0)")) S V(V)=$P(^(0),U,1)
S DJZ=+$P($P(^DD(DJZ,.01,0),"^",2),"P",2) Q:$P(^DD(DJZ,.01,0),"^",2)'["P" G P11
DCS S DJNODE=.01 Q:DJ4'["P"
S DJ44=$S(DJ4'["'":DJ4,1:$P(DJ4,"P",2))
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)
I DJNODE=.01,$D(^DD(DJDD,DJ3,12.1)) X ^(12.1) G DCS1
K DIC("S") Q:'$D(^DD(+DJ44,DJNODE)) S:'$D(DIC(0)) DIC(0)=""
I $D(^DD(+DJ44,DJNODE,12.1)) X ^(12.1)
E K DJNODE,DJ44 Q
DCS1 S:'$D(DIC(0)) DIC(0)="" K:DIC(0)'="" DIC("S") K DJNODE,DJ44 Q
DEDJHELP ;
S DECNT=0,DEDJHELP(1)=^DD(DJDD,DJAT,3)
D DEDJHEL1
R !,"Press <RETURN> to Continue: ",DEXRET:DTIME
X DJCP
K DEDJHELP,DECNT,DEXRET
Q
DEDJHEL1 ;
S DECNT=DECNT+1
Q:'$D(DEDJHELP(DECNT))
F I=79:-1:1 Q:$E(DEDJHELP(DECNT),I)=" "
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)
W !,DEDJHELP(DECNT)
G DEDJHEL1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTDNQ 3894 printed Oct 16, 2024@17:47:18 Page 2
DENTDNQ ;WASH ISC/TJK,JA,NCA-SCREEN INPUT-QUESTIONMARKS ;8/28/92 09:08
+1 ;;1.2;DENTAL;**15,23**;NOV 1993
+2 SET D=""
A SET DJX=""
XECUTE DJCP
+1 IF DJ4["R"
WRITE "**REQUIRED**",*7
+2 if '$DATA(X)
SET X=DJXX
if X'="??"
GOTO F
if '$DATA(^DD(DJDD,DJAT,21,0))
GOTO F
if '$PIECE(^(0),U,4)
GOTO F
+3 SET DJZ1=0
SET DIWL=1
SET DIWR=79
SET DIWF=""
KILL ^UTILITY($JOB,"W")
+4 SET DJXX=X
FOR DJK=1:1
SET DJZ1=$ORDER(^DD(DJDD,DJAT,21,DJZ1))
if DJZ1=""
QUIT
SET X=^(DJZ1,0)
DO ^DIWP
+5 ; purge WP buffer
DO ^DIWW
+6 SET DJZ1=0
FOR DJK=1:1
SET DJZ1=$ORDER(^UTILITY($JOB,"W",DIWL,DJZ1))
if DJZ1=""
QUIT
if $Y>21
DO CONT
if DJX[U
QUIT
WRITE !,^(DJZ1,0)
+7 KILL DJZ1,DJK,^UTILITY($JOB,"W",DIWL),DIWL,DIWR,DIWF
SET X=DJXX
if DJX'[U
GOTO F
QUIT
CONT WRITE !,"Press <RETURN> to Continue, '^' to Quit: "
READ DJX:DTIME
+1 IF $Y>22
SET DJSV=V
DO N^DENTDPL
SET V=DJSV
+2 XECUTE DJCP
WRITE !
+3 QUIT
F if $Y>21
DO CONT
IF DJX[U
DO FUNC^DENTDNQ2
QUIT
+1 if $DATA(^DD(DJDD,DJAT,3))
DO DEDJHELP
IF $DATA(^DD(DJDD,DJAT,4))
WRITE !
XECUTE ^(4)
+2 IF DJ4["S"
IF DJ4'["M"
if $Y>21
DO CONT
if DJX[U
GOTO END
Begin DoDot:1
+3 WRITE !,"CHOOSE FROM:"
SET DJS=$PIECE(^DD(DJDD,DJAT,0),U,3)
+4 FOR DJK=1:1
SET Y=$PIECE(DJS,";",DJK)
if Y=""
QUIT
Begin DoDot:2
+5 SET Y="'"_$PIECE(Y,":",1)_"' FOR "_$PIECE(Y,":",2)
+6 if $Y>21
DO CONT
if DJX[U
QUIT
+7 WRITE !,Y
QUIT
End DoDot:2
+8 DO CONT
QUIT
End DoDot:1
DO FUNC^DENTDNQ2
+9 DO DCS
+10 IF DJ4["P"
KILL DIC("S")
SET DJDIC=DIC
SET DJD0=D0
SET DIC(0)=$SELECT(DJ4["'":"MEQZ",1:"MEQZL")
SET DIC=+$PIECE(DJ4,"P",2)
if $Y>21
DO CONT
if $PIECE(^DD(DJDD,DJAT,0),U,2)["*"
XECUTE ^(12.1)
DO ^DENTDC
KILL DIC
SET DIC=DJDIC
SET D0=DJD0
if Y<0
GOTO R1
SET V(V)=$PIECE(Y,U,2)
GOTO P1
+11 IF DJ4["D"
if '$DATA(%DT)
SET %DT="E"
DO HELP
+12 IF DJ4["N"
DO FUNC^DENTDNQ2
+13 KILL DJS,DJZ1
IF $Y>23
XECUTE DJCL
READ "Press <RETURN> to Continue",X:DTIME
SET DJZ=V
DO N^DENTDPL
SET V=DJZ
QUIT
+14 SET @$PIECE(DJJ(V),U,2)
XECUTE XY
WRITE V(V)
QUIT
P DO DCS
+1 KILL DIC("S")
SET DJDIC=DIC
SET DJD0=D0
SET DIC(0)=$SELECT(DJ4["'":"MEQZ",1:"MEQZL")
SET DIC=+$PIECE(DJ4,"P",2)
XECUTE DJCP
if $PIECE(^DD(DJDD,DJAT,0),U,2)["*"
XECUTE ^(12.1)
DO ^DENTDC
KILL DIC
if +Y>0
SET V(V)=$EXTRACT($PIECE(Y,U,2),1,+DJJ(V))
SET DIC=DJDIC
SET D0=DJD0
if Y<0
GOTO R1
P1 SET X=+Y
SET V(V)=$EXTRACT($PIECE(Y,U,2),1,+DJJ(V))
SET (DIE,DIC)=DJDIC
SET DA=DJDN
SET DR=DJ3_"////"_X
XECUTE DJCP
WRITE !
DO ^DIE
SET D0=DJD0
KILL DJD0
DO PP
SET V(V)=$EXTRACT(V(V),1,+DJJ(V))
+1 SET YMLH=$ORDER(^DENT(697.3,DJN,1,"A",V,0))
if YMLH=""
SET YMLH=-1
+2 if $DATA(^DENT(697.3,DJN,1,YMLH,1))
XECUTE ^(1)
+3 IF $Y>23
SET DJZ=V
DO N^DENTDPL
SET V=DJZ
QUIT
+4 SET DY=17
SET DX=0
XECUTE XY
WRITE DJEOP
SET @$PIECE(DJJ(V),U,2)
XECUTE XY
WRITE DJHIN
XECUTE XY
WRITE V(V),DJLIN
DO FUNC^DENTDNQ2
QUIT
END ; Exit and Display Commands
+1 DO FUNC^DENTDNQ2
QUIT
R1 KILL DJD0
SET DIC=DJDIC
+1 SET @$PIECE(DJJ(V),U,2)
XECUTE XY
if $DATA(V(V))
WRITE DJHIN
if $DATA(V(V))
WRITE V(V)
XECUTE XY
DO FUNC^DENTDNQ2
QUIT
HELP if $Y>21
DO R
WRITE !,"EXAMPLES OF VALID DATES:"
+1 if $Y>21
DO R
WRITE !," JAN 22 1957 or 22 JAN 57 or 1/22/57 or 012257"
+2 if $Y>21
DO R
WRITE !," T (FOR TODAY), T+1 (FOR TOMORROW), T+2, T+7, etc."," T-1 (FOR YESTERDAY)"
+3 if $Y>21
DO R
WRITE !," T-3W (3 WEEKS AGO), etc."
+4 if $Y>21
DO R
WRITE !,"IF THE YEAR IS OMITTED, THE COMPUTER USES THE CURRENT YEAR",!
+5 if $Y>21
DO R
IF %DT'["X"
WRITE "YOU MAY OMIT THE PRECISE DAY, AS: JAN, 1957",!
+6 if $Y>21
DO R
IF %DT["T"
WRITE "FOLLOW DATE WITH TIME, AS: JAN 22@10, T@10PM, ETC."
+7 QUIT
R XECUTE DJCL
WRITE "Press <RETURN> to Continue"
READ DJX:10
XECUTE DJCP
PP SET DJZ=+$PIECE($PIECE(^DD(DJDD,DJAT,0),"^",2),"P",2)
if $PIECE(^DD(DJZ,.01,0),"^",2)'["P"
QUIT
P11 IF $DATA(@("^"_$PIECE(^DD(DJZ,.01,0),U,3)_"V(V),0)"))
SET V(V)=$PIECE(^(0),U,1)
+1 SET DJZ=+$PIECE($PIECE(^DD(DJZ,.01,0),"^",2),"P",2)
if $PIECE(^DD(DJZ,.01,0),"^",2)'["P"
QUIT
GOTO P11
DCS SET DJNODE=.01
if DJ4'["P"
QUIT
+1 SET DJ44=$SELECT(DJ4'["'":DJ4,1:$PIECE(DJ4,"P",2))
+2 if '$DATA(^DD(+DJ44,0,"UP"))
QUIT
IF $DATA(^DD(^DD(+DJ44,0,"UP"),0,"UP"))
SET DJ44=^DD(+DJ44,0,"UP")
SET DJNODE=$PIECE(DJJ(V),U,3)
+3 IF DJNODE=.01
IF $DATA(^DD(DJDD,DJ3,12.1))
XECUTE ^(12.1)
GOTO DCS1
+4 KILL DIC("S")
if '$DATA(^DD(+DJ44,DJNODE))
QUIT
if '$DATA(DIC(0))
SET DIC(0)=""
+5 IF $DATA(^DD(+DJ44,DJNODE,12.1))
XECUTE ^(12.1)
+6 IF '$TEST
KILL DJNODE,DJ44
QUIT
DCS1 if '$DATA(DIC(0))
SET DIC(0)=""
if DIC(0)'=""
KILL DIC("S")
KILL DJNODE,DJ44
QUIT
DEDJHELP ;
+1 SET DECNT=0
SET DEDJHELP(1)=^DD(DJDD,DJAT,3)
+2 DO DEDJHEL1
+3 READ !,"Press <RETURN> to Continue: ",DEXRET:DTIME
+4 XECUTE DJCP
+5 KILL DEDJHELP,DECNT,DEXRET
+6 QUIT
DEDJHEL1 ;
+1 SET DECNT=DECNT+1
+2 if '$DATA(DEDJHELP(DECNT))
QUIT
+3 FOR I=79:-1:1
if $EXTRACT(DEDJHELP(DECNT),I)=" "
QUIT
+4 IF $LENGTH(DEDJHELP(DECNT))>79
SET DEDJHELP(DECNT+1)=$EXTRACT(DEDJHELP(DECNT),I+1,$LENGTH(DEDJHELP(DECNT)))
SET DEDJHELP(DECNT)=$EXTRACT(DEDJHELP(DECNT),1,I-1)
+5 WRITE !,DEDJHELP(DECNT)
+6 GOTO DEDJHEL1
