source: FOIAVistA/tag/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDIZ.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1YSDIZ ;SLC/RWF-ONE FIELD ^DIE FORMAT QUES. ASKER ; 7/6/89 17:04 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 ; Called from YSPHY1
5 ;CALL DQ = ^DD(FILE#, FIELD#, 0) FORMAT STRING TO ASK
6 ; DE = CURRENT VALUE
7 ; DP = FILE # OR, -1 AND DQ(3) HAS THE HELP MESSAGE
8 G EN
9RD ;
10 W !,$P(DQ,U),": " W:$L(YSDE) Y,"// " R X:DTIME S YSTOUT='$T,YSUOUT=X["^" Q
11EN ;
12 S DV=$P(DQ,U,2),DU=$P(DQ,U,3) S:'$D(YSDE) YSDE="" G PR:$L(YSDE)
13EN1 ;
14 D RD IF X=""!X["^" W:DV["R" $C(7)," REQUIRED" G EN1:DV["R",END
15E ;
16 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
17S ;
18 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
19P ;
20 IF DV["P" S DIC=U_DU,DIC(0)="EQM" D ^DIC S X=+Y G X:X<0
21V ;
22 X $P(DQ,U,5,99) I $D(X) S YSDE=X G END
23X ;
24 W $C(7),"??" G EN
25END ;
26 K DU,YSDG,D,DV Q
27 ;
28PR ;
29 S YSDG=DV,Y=YSDE,X=DU
30R ;
31 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
32 I YSDG["S" S X=$F(";"_DU,";"_Y_":") S:X Y=$P($E(DU,X-1,999),";") G RP
33 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)
34RP ;
35 D RD G E:X]"" S X=YSDE G END
36 ;
37D ;
38 W $C(7)," ",!?3,"SURE YOU WANT TO DELETE"
39 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
40 S YSDE="" G EN:DV["R",END
41 ;
42QS ;
43 IF DP<0 W:$D(DQ(3)) !?5,DQ(3) X:$D(DQ(4)) DQ(4)
44 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)
45 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
46 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'"
47 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)
48 G EN
49 ;
50FN(ROOT) ;
51 S X="S RNUM=+$P("_ROOT_"0),U,2)\1" X X K X
52 QUIT RNUM
Note: See TracBrowser for help on using the repository browser.