47 lines
2.1 KiB
Mathematica
47 lines
2.1 KiB
Mathematica
FHPRC6 ; HISC/REL/NCA - Edit Meal Production Diets ;2/26/96 10:04
|
|
;;5.5;DIETETICS;;Jan 28, 2005
|
|
R0 S DIC="^FH(116.1,",DIC(0)="AEQM" W ! D ^DIC K DIC G KIL:U[X!$D(DTOUT),R0:Y<1 S D0=+Y
|
|
R1 S DIC="^FH(116.1,D0,""RE"",",DIC(0)="AEQM" W ! D ^DIC K DIC G KIL:X[U!$D(DTOUT),R0:X="",R1:Y<1 S D1=+Y
|
|
Q:$O(^FH(116.1,D0,"RE",D1,"R",0))<1
|
|
R11 S DIC="^FH(116.1,D0,""RE"",D1,""R"",",DIC(0)="AEQM" W ! D ^DIC K DIC G KIL:X[U!$D(DTOUT),R1:X="",R11:Y<1 S CAT=+Y
|
|
S OLD=$P(^FH(116.1,D0,"RE",D1,"R",CAT,0),"^",2)
|
|
I $E(OLD,$L(OLD))=" " S OLD=$E(OLD,1,$L(OLD)-1)
|
|
S NEW=OLD D IN
|
|
R2 D LI R !!,"Action: ",Y:DTIME G:'$T KIL I "^"[Y S:OLD'=NEW $P(^FH(116.1,D0,"RE",D1,"R",CAT,0),"^",2)=NEW G R1
|
|
I Y["?" D IN G R2
|
|
S X=Y D TR^FH S Y=X
|
|
S Z=$E(Y,1),FLG=0 G AD:Z="+",DE:Z="-",MO
|
|
Q
|
|
AD S FHX1=$E(Y,2,999) F LL=1:1 Q:$P(FHX1," ",LL,99)="" S FHX2=$P(FHX1," ",LL),PD=$P(FHX2,";",1) D A1 Q:'$D(X)
|
|
W:'FLG " ok"
|
|
G R2
|
|
A1 D CK I X6<0 S FLG=1 Q
|
|
I X6 W *7,!?5," ",FHX2," already exists! Use Modify option." S FLG=1 Q
|
|
S X=NEW_" "_FHX2 S:$E(X,1)=" " X=$E(X,2,999) D EN2^FHPRC1 I $D(X) S NEW=X
|
|
Q
|
|
DE S FHX1=$E(Y,2,999) F LL=1:1 Q:$P(FHX1," ",LL,99)="" S FHX2=$P(FHX1," ",LL),PD=$P(FHX2,";",1) D D1
|
|
W:'FLG " ok"
|
|
G R2
|
|
D1 D CK I X6<0 S FLG=1 Q
|
|
I 'X6 W *7,!?5," ",FHX2," does not exist!" S FLG=1 Q
|
|
S X=$P(NEW," ",1,X6-1)_" "_$P(NEW," ",X6+1,999) S:$E(X,1)=" " X=$E(X,2,999) S:$E(X,$L(X))=" " X=$E(X,1,$L(X)-1)
|
|
D EN2^FHPRC1 I $D(X) S NEW=X
|
|
Q
|
|
MO S PD=$E(Y,1,2) D CK G:X6<0 R2
|
|
I 'X6 W *7," ",PD," does not exist!" G R2
|
|
S X=NEW,$P(X," ",X6)=Y I $L(X)>200 W *7,!!?5,"String Length >200." K X G R2
|
|
D EN2^FHPRC1 I $D(X) S NEW=X W " ok"
|
|
G R2
|
|
CK S:PD'?1U1UN PD="---" I '$D(^FH(116.2,"C",PD)) W *7,!?5," ",PD," Not a valid Production Diet code!" S X6=-1 Q
|
|
S X6=0 F K=1:1 S Z=$P(NEW," ",K) Q:Z="" I $E(Z,1,2)=PD S X6=K Q
|
|
Q
|
|
E1 W *7," Illegal Production Diet code" G R2
|
|
LI W !!,"Production Diets: " S X=NEW
|
|
L1 I $L(X)<61 W ?19,X Q
|
|
F N1=61:-1:1 Q:$E(X,N1)=" "
|
|
W ?19,$E(X,1,N1-1) S X=$E(X,N1+1,999) Q:X="" W ! G L1
|
|
IN W !!?5,"Enter + to add (example: +RG;C50)"
|
|
W !?5,"Enter -Production Diet to delete (example: -RG)"
|
|
W !?5,"Enter new code to modify (example: LS;C30)" Q
|
|
KIL G KILL^XUSCLEAN
|