YSDIZ.m

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 ---YSDIZ   2106     printed  Mar 13, 2025@21:18:58                                                                                                                                                                                                       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