YSDIZ ;SLC/RWF-ONE FIELD ^DIE FORMAT QUES. ASKER ; 7/6/89 17:04 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
; Called from YSPHY1
;CALL DQ = ^DD(FILE#, FIELD#, 0) FORMAT STRING TO ASK
; DE = CURRENT VALUE
; DP = FILE # OR, -1 AND DQ(3) HAS THE HELP MESSAGE
G EN
RD ;
W !,$P(DQ,U),": " W:$L(YSDE) Y,"// " R X:DTIME S YSTOUT='$T,YSUOUT=X["^" Q
EN ;
S DV=$P(DQ,U,2),DU=$P(DQ,U,3) S:'$D(YSDE) YSDE="" G PR:$L(YSDE)
EN1 ;
D RD IF X=""!X["^" W:DV["R" $C(7)," REQUIRED" G EN1:DV["R",END
E ;
G QS:X="?",D:X="@",END:X[U,P:DV'["S" S YSDH=DU,Y=$F(";"_DU,";"_X_":") IF Y W " (",$P($E(DU,Y-1,256),";"),")" G V
S ;
S Y=$P(YSDH,";"),YSDH=$P(YSDH,";",2,99),YSDG=$F(Y,":"_X) G:'YSDG S:Y]"",X W $E(Y,YSDG,999) S X=$P(Y,":") G V
P ;
IF DV["P" S DIC=U_DU,DIC(0)="EQM" D ^DIC S X=+Y G X:X<0
V ;
X $P(DQ,U,5,99) I $D(X) S YSDE=X G END
X ;
W $C(7),"??" G EN
END ;
K DU,YSDG,D,DV Q
;
PR ;
S YSDG=DV,Y=YSDE,X=DU
R ;
I YSDG["P",@("$D(^"_X_"0))") S X=+$P(^(0),U,2) G RP:'$D(^(Y,0)) S Y=$P(^(0),U),X=$P(^DD(X,.01,0),U,3),YSDG=$P(^(0),U,2) G R
I YSDG["S" S X=$F(";"_DU,";"_Y_":") S:X Y=$P($E(DU,X-1,999),";") G RP
I YSDG["D" S X=Y,Y=Y\10000+1700 S:$E(X,6,7) Y=+$E(X,6,7)_"-"_Y S:$E(X,4,5) Y=+$E(X,4,5)_"-"_Y I X#1 S Y=Y_"@"_$E(X_0,9,10)_":"_$E(X_"000",11,12)
RP ;
D RD G E:X]"" S X=YSDE G END
;
D ;
W $C(7)," ",!?3,"SURE YOU WANT TO DELETE"
R "? ",X:DTIME S YSTOUT='$T,YSUOUT=X["^" Q:YSTOUT I X'?1"Y".E W:$X>55 !?9 W $C(7)," <NOTHING DELETED>" G EN
S YSDE="" G EN:DV["R",END
;
QS ;
IF DP<0 W:$D(DQ(3)) !?5,DQ(3) X:$D(DQ(4)) DQ(4)
E S D=$P(DQ,U,4),D=$O(^DD(DP,"GL",$P(D,";"),$P(D,";",2),0)) I D W:$D(^DD(DP,D,.1)) !?5,^(.1) W:$D(^(3)) !?5,^(3) X:$D(^(4)) ^(4)
I DV["P" K DO S DIC=U_DU,D="B",DIC(0)="LM",DLAYGO=$$FN(DIC) D DQ^DICQ K DIC,DO,DS,DX
I DV["D" W !," ENTER DATE AS 'MONTH-DAY-YEAR'" I $P($P($P(DQ(DQ),U,5),"%DT=""",2),"""",1)'["X" W ", OR 'MONTH-YEAR'"
I DV["S" W !,"CHOOSE FROM: " F YSDG=1:1 S Y=$P(DU,";",YSDG) Q:Y="" W !?7,$P(Y,":"),?15," ",$P(Y,":",2)
G EN
;
FN(ROOT) ;
S X="S RNUM=+$P("_ROOT_"0),U,2)\1" X X K X
QUIT RNUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDIZ 2106 printed Apr 09, 2024@21:19:35 Page 2
YSDIZ ;SLC/RWF-ONE FIELD ^DIE FORMAT QUES. ASKER ; 7/6/89 17:04 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 ; Called from YSPHY1
+4 ;CALL DQ = ^DD(FILE#, FIELD#, 0) FORMAT STRING TO ASK
+5 ; DE = CURRENT VALUE
+6 ; DP = FILE # OR, -1 AND DQ(3) HAS THE HELP MESSAGE
+7 GOTO EN
RD ;
+1 WRITE !,$PIECE(DQ,U),": "
if $LENGTH(YSDE)
WRITE Y,"// "
READ X:DTIME
SET YSTOUT='$TEST
SET YSUOUT=X["^"
QUIT
EN ;
+1 SET DV=$PIECE(DQ,U,2)
SET DU=$PIECE(DQ,U,3)
if '$DATA(YSDE)
SET YSDE=""
if $LENGTH(YSDE)
GOTO PR
EN1 ;
+1 DO RD
IF X=""!X["^"
if DV["R"
WRITE $CHAR(7)," REQUIRED"
if DV["R"
GOTO EN1
GOTO END
E ;
+1 if X="?"
GOTO QS
if X="@"
GOTO D
if X[U
GOTO END
if DV'["S"
GOTO P
SET YSDH=DU
SET Y=$FIND(";"_DU,";"_X_":")
IF Y
WRITE " (",$PIECE($EXTRACT(DU,Y-1,256),";"),")"
GOTO V
S ;
+1 SET Y=$PIECE(YSDH,";")
SET YSDH=$PIECE(YSDH,";",2,99)
SET YSDG=$FIND(Y,":"_X)
if 'YSDG
if Y]""
GOTO S
GOTO X
WRITE $EXTRACT(Y,YSDG,999)
SET X=$PIECE(Y,":")
GOTO V
P ;
+1 IF DV["P"
SET DIC=U_DU
SET DIC(0)="EQM"
DO ^DIC
SET X=+Y
if X<0
GOTO X
V ;
+1 XECUTE $PIECE(DQ,U,5,99)
IF $DATA(X)
SET YSDE=X
GOTO END
X ;
+1 WRITE $CHAR(7),"??"
GOTO EN
END ;
+1 KILL DU,YSDG,D,DV
QUIT
+2 ;
PR ;
+1 SET YSDG=DV
SET Y=YSDE
SET X=DU
R ;
+1 IF YSDG["P"
IF @("$D(^"_X_"0))")
SET X=+$PIECE(^(0),U,2)
if '$DATA(^(Y,0))
GOTO RP
SET Y=$PIECE(^(0),U)
SET X=$PIECE(^DD(X,.01,0),U,3)
SET YSDG=$PIECE(^(0),U,2)
GOTO R
+2 IF YSDG["S"
SET X=$FIND(";"_DU,";"_Y_":")
if X
SET Y=$PIECE($EXTRACT(DU,X-1,999),";")
GOTO RP
+3 IF YSDG["D"
SET X=Y
SET Y=Y\10000+1700
if $EXTRACT(X,6,7)
SET Y=+$EXTRACT(X,6,7)_"-"_Y
if $EXTRACT(X,4,5)
SET Y=+$EXTRACT(X,4,5)_"-"_Y
IF X#1
SET Y=Y_"@"_$EXTRACT(X_0,9,10)_":"_$EXTRACT(X_"000",11,12)
RP ;
+1 DO RD
if X]""
GOTO E
SET X=YSDE
GOTO END
+2 ;
D ;
+1 WRITE $CHAR(7)," ",!?3,"SURE YOU WANT TO DELETE"
+2 READ "? ",X:DTIME
SET YSTOUT='$TEST
SET YSUOUT=X["^"
if YSTOUT
QUIT
IF X'?1"Y".E
if $X>55
WRITE !?9
WRITE $CHAR(7)," <NOTHING DELETED>"
GOTO EN
+3 SET YSDE=""
if DV["R"
GOTO EN
GOTO END
+4 ;
QS ;
+1 IF DP<0
if $DATA(DQ(3))
WRITE !?5,DQ(3)
if $DATA(DQ(4))
XECUTE DQ(4)
+2 IF '$TEST
SET D=$PIECE(DQ,U,4)
SET D=$ORDER(^DD(DP,"GL",$PIECE(D,";"),$PIECE(D,";",2),0))
IF D
if $DATA(^DD(DP,D,.1))
WRITE !?5,^(.1)
if $DATA(^(3))
WRITE !?5,^(3)
if $DATA(^(4))
XECUTE ^(4)
+3 IF DV["P"
KILL DO
SET DIC=U_DU
SET D="B"
SET DIC(0)="LM"
SET DLAYGO=$$FN(DIC)
DO DQ^DICQ
KILL DIC,DO,DS,DX
+4 IF DV["D"
WRITE !," ENTER DATE AS 'MONTH-DAY-YEAR'"
IF $PIECE($PIECE($PIECE(DQ(DQ),U,5),"%DT=""",2),"""",1)'["X"
WRITE ", OR 'MONTH-YEAR'"
+5 IF DV["S"
WRITE !,"CHOOSE FROM: "
FOR YSDG=1:1
SET Y=$PIECE(DU,";",YSDG)
if Y=""
QUIT
WRITE !?7,$PIECE(Y,":"),?15," ",$PIECE(Y,":",2)
+6 GOTO EN
+7 ;
FN(ROOT) ;
+1 SET X="S RNUM=+$P("_ROOT_"0),U,2)\1"
XECUTE X
KILL X
+2 QUIT RNUM
