| 1 | FHPRC6 ; HISC/REL/NCA - Edit Meal Production Diets ;2/26/96 10:04
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005
|
|---|
| 3 | 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
|
|---|
| 4 | 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
|
|---|
| 5 | Q:$O(^FH(116.1,D0,"RE",D1,"R",0))<1
|
|---|
| 6 | 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
|
|---|
| 7 | S OLD=$P(^FH(116.1,D0,"RE",D1,"R",CAT,0),"^",2)
|
|---|
| 8 | I $E(OLD,$L(OLD))=" " S OLD=$E(OLD,1,$L(OLD)-1)
|
|---|
| 9 | S NEW=OLD D IN
|
|---|
| 10 | 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
|
|---|
| 11 | I Y["?" D IN G R2
|
|---|
| 12 | S X=Y D TR^FH S Y=X
|
|---|
| 13 | S Z=$E(Y,1),FLG=0 G AD:Z="+",DE:Z="-",MO
|
|---|
| 14 | Q
|
|---|
| 15 | 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)
|
|---|
| 16 | W:'FLG " ok"
|
|---|
| 17 | G R2
|
|---|
| 18 | A1 D CK I X6<0 S FLG=1 Q
|
|---|
| 19 | I X6 W *7,!?5," ",FHX2," already exists! Use Modify option." S FLG=1 Q
|
|---|
| 20 | S X=NEW_" "_FHX2 S:$E(X,1)=" " X=$E(X,2,999) D EN2^FHPRC1 I $D(X) S NEW=X
|
|---|
| 21 | Q
|
|---|
| 22 | 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
|
|---|
| 23 | W:'FLG " ok"
|
|---|
| 24 | G R2
|
|---|
| 25 | D1 D CK I X6<0 S FLG=1 Q
|
|---|
| 26 | I 'X6 W *7,!?5," ",FHX2," does not exist!" S FLG=1 Q
|
|---|
| 27 | 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)
|
|---|
| 28 | D EN2^FHPRC1 I $D(X) S NEW=X
|
|---|
| 29 | Q
|
|---|
| 30 | MO S PD=$E(Y,1,2) D CK G:X6<0 R2
|
|---|
| 31 | I 'X6 W *7," ",PD," does not exist!" G R2
|
|---|
| 32 | S X=NEW,$P(X," ",X6)=Y I $L(X)>200 W *7,!!?5,"String Length >200." K X G R2
|
|---|
| 33 | D EN2^FHPRC1 I $D(X) S NEW=X W " ok"
|
|---|
| 34 | G R2
|
|---|
| 35 | 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
|
|---|
| 36 | S X6=0 F K=1:1 S Z=$P(NEW," ",K) Q:Z="" I $E(Z,1,2)=PD S X6=K Q
|
|---|
| 37 | Q
|
|---|
| 38 | E1 W *7," Illegal Production Diet code" G R2
|
|---|
| 39 | LI W !!,"Production Diets: " S X=NEW
|
|---|
| 40 | L1 I $L(X)<61 W ?19,X Q
|
|---|
| 41 | F N1=61:-1:1 Q:$E(X,N1)=" "
|
|---|
| 42 | W ?19,$E(X,1,N1-1) S X=$E(X,N1+1,999) Q:X="" W ! G L1
|
|---|
| 43 | IN W !!?5,"Enter + to add (example: +RG;C50)"
|
|---|
| 44 | W !?5,"Enter -Production Diet to delete (example: -RG)"
|
|---|
| 45 | W !?5,"Enter new code to modify (example: LS;C30)" Q
|
|---|
| 46 | KIL G KILL^XUSCLEAN
|
|---|
