PSGON ;BIR/CML3-SELECT ORDERS ;14-Feb-2013 11:06;PB
;;5.0; INPATIENT MEDICATIONS ;**2,22,54,1015**;16 DEC 97;Build 62
;
; Modified - IHS/MSC/PB - 4/20/12 - Modified H2+21 to add the Stability Offset Value field to the list of fields that can be edited
; IHS/MSC/PB - 2/13/13 - Modified H2+22 to change the wording of the Beyond Use Date to Beyond Use Days and to correct the numbering sequence for the fields
ENCHK ;
K PSGODDD S PSGODDD=1,PSGODDD(1)="" W:X="-" " (ALL)" I X="ALL"!(X="-") S X="1-"_PSGLMT
E S:$E(X)="-" X=1_X S:$E(X,$L(X))="-" X=X_PSGLMT
F Q=1:1:$L(X,",") S X1=$P(X,",",Q) D SET Q:'$D(X)
Q
;
SET ;
I $S(X1>PSGLMT:1,X1<1:1,X1?.N:0,1:X1'?1.N1"-"1.N) K X Q
I X1'["-" S X2=X1 G SET1
F X2=$P(X1,"-"):1:$P(X1,"-",2) D SET1 Q:'$D(X)
Q
;
SET1 ;
S X2=+X2 I $S(X2<1:1,X2>PSGLMT:1,$D(PSGEFN):'$D(PSGEFN(X2)),1:0) K X Q
I PSGODDD(PSGODDD) F QQ=+$G(PSGOESF):1:PSGODDD I ","_$G(PSGODDD(QQ))[(","_X2_",") Q
I Q
I $L(PSGODDD(PSGODDD))+$L(X2)>244 S PSGODDD=PSGODDD+1,PSGODDD(PSGODDD)=""
S PSGODDD(PSGODDD)=PSGODDD(PSGODDD)_X2_"," ;Q
Q
;
ENASR ; action/select read
;S ACTION=$S($D(PSGPRF):0,PSGONC:1,PSGONV:1,$G(PSGONF):1,1:PSGONR>0)
S ACTION=0
RD1 ;W !!,$S($D(PSGPRF):"View",1:"Select"),$S(ACTION:" ACTION or",1:"")," ORDER",$S(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),"): " R X:DTIME W:'$T $C(7) S:'$T X="^" I "^"[X K ACTION Q
W !!,$S($D(PSGPRF):"View",1:"Select"),$S(ACTION:" ACTION or",1:"")," ORDER",$S(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),"): " R X:DTIME W:'$T $C(7) S:'$T X="^" I X["^" K ACTION S X="^" Q
I X="" K ACTION Q
I X="DC",ACTION,PSGONC W " (DISCONTINUE)" S X="D" Q
I X="DC" W $C(7)," ??" G RD1
I $P("DISCONTINUE",X)="",ACTION,PSGONC W $P("DISCONTINUE",X,2) S X="D" Q
I $P("DISCONTINUE",X)="" W $C(7)," ??" G RD1
I $P("RENEW",X)="",ACTION,PSGONR W $P("RENEW",X,2) S X="R" Q
I $P("RENEW",X)="" W $C(7)," ??" G RD1
I $P("VERIFY",X)="",ACTION,PSGONV W $P("VERIFY",X,2) S X="V" Q
I $P("VERIFY",X)="" W $C(7)," ??" G RD1
I $P("FINISH",X)="",ACTION,$G(PSGONF) W $P("FINISH",X,2) S X="F" Q
I $P("FINISH",X)="" W $C(7)," ??" G RD1
I $S(X="ALL":1,X["-":1,1:X) D ENCHK Q:$D(X) W $C(7)," ??" G RD1
I X?1."?" D H1 G RD1
W $C(7)," ??" G RD1
;
H1 ;
D FULL^VALM1 W !!?2 I ACTION D
.W "Select ACTION to take on order",$E("s",PSGONR>1!(PSGONC>1)!(PSGONV>1)!($G(PSGONF)>1)),!,". Select -",! W:PSGONC ?9,"D for DISCONTINUE",! W:PSGONR ?9,"R for RENEW",! W:PSGONV ?9,"V for VERIFY",! W:$G(PSGONF) ?9,"F for FINISH",!
W !,"Select ORDER",$S(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),") to view",$S('$D(PSGPRF):" and/or on which to take action",1:""),"." D:X?2."?" H2
N DIR S DIR(0)="E" D ^DIR I $D(VALM("LINES")) D RE^VALM4
Q
;
ENWO ; which orders
S PSGLMT=$S(PSGONW="R":PSGONR,PSGONW="V":PSGONV,1:PSGONC)
RDW ;
W !!,$S(PSGONW="V":"VERIFY which orders",PSGONW="R":$S($P(PSJSYSP0,"^",3):"RENEW which orders",1:"MARK which orders for RENEWAL"),1:$S($P(PSJSYSP0,"^",5):"DISCONTINUE which orders",1:"MARK which orders for DISCONTINUATION"))," (1-",PSGLMT,"): "
R X:DTIME W:'$T $C(7) S:'$T X="^" I "^"[X Q
I X?1."?" W !!?2,"Select order",$E("s",PSGLMT>1)," to ",$S(PSGONW="V":"verify",PSGONW="R":$S($P(PSJSYSP0,"^",3):"renew.",1:"mark for renewal."),1:$S($P(PSJSYSP0,"^",5):"discontinue.",1:"mark for discontinuation.")) D:X?2."?" H2 G RDW
D ENCHK I '$D(X) W $C(7)," ??" G RDW
Q
;
H2 ;
N X S X=$S($D(PSGEFN):"field",1:"order") W !!?2,"Select ",X,"s either singularly separated by commas (1,2,3), by a range of",!,X,"s separated by a dash (1-3), or a combination (1,2,4-6). To select all"
W !,X,"s, enter 'ALL' or a dash ('-'). You can also enter '-n' to select the"
W !,"first ",X," through the 'nth' ",X," or enter 'n-' to select the 'nth' ",X,!,"through the last ",X,". If an ",X," is selected more than once, only the first",!,"selection is used (Entering '1,2,1' would return '1,2'.)."
W:$D(PSGEFN) !!,?2,"Fields numbers are as follows:"
I '$D(P("PON")) D
.Q:'$D(PSGEFN)
.N PS S PS=$S($G(PSJORD)["P":1,$G(PSJORD)["U":2,1:2)
.W !?3,"*(1) Orderable Item",!,?3,$S(PS=1:" ",PS=2:"*"),"(2) Dosage Ordered"
.W !?3,$S(PS=1:" ",PS=2:"*"),"(3) Start",!?3,"*(4) Med Route",!?3,$S(PS=1:" ",PS=2:"*"),"(5) Stop"
.W !?3," (6) Schedule Type",!?3," (7) Self Med",!?3,"*(8) Schedule"
.W !?3," (9) Admin Times",!?3,"*(10) Provider",!?3," (11) Special "
.W "Instructions",!?3," (12) Dispense Drug"
E D
.Q:'$D(PSGEFN)
.N PS S PS=$S($G(PSJORD)["P":1,$G(PSJORD)["V":2,1:2)
.W !?3,$S($G(P("OT"))="F":"*",PS=1:" ",PS=2:"*"),"(1) Additives",!?3,$S($G(P("OT"))="F":"*",P(4)="P":" ",PS=1:" ",PS=2:"*"),"(2) Solutions",!?3,$S(P(4)="P":" ",PS=1:" ",PS=2:"*"),"(3) Infusion Rate"
.W !?3,$S(PS=1:" ",PS=2:"*"),"(4) Start",!?3,"*(5) Med Route",!?3,$S(PS=1:" ",PS=2:"*"),"(6) Stop"
.W !?3,"*(7) Schedule",!?3," (8) Admin Times",!?3,"*(9) Provider"
.I $G(P(4))="P"!($G(P("DTYP"))=0) D
..W !?3,"*(10) Orderable Item",!?3," (11) Other Print",!?3," (12) Remarks"
.;line below modified to add the Stability Offset Value to the list of fields that can be edited
.;E W !?3," (10) Other Print",!?3," (11) Remarks"
.;IHS/MSC/PB 4/25/12 Modified to display the Beyond Use Date field in the list of fields to be edited
.;ISH/MSC/PB - 2/13/13 modified the line below to change the wording of the Beyond Use line and to correct the field numbering
.;E W !?3," (10) Other Print",!?3," (11) Remarks",!?3," (12) Beyond Use Days"
.E W !?3," (11) Other Print",!?3," (12) Remarks",!?3," (13) Beyond Use Days"
W ! K DIR S DIR(0)="E" D ^DIR K DIR
Q
;
ENEFA ;
N Q,X1,X2 I '$D(PSGEFN) K Y S Y="" Q
;
EFA ;
K Y S Y="" R !!,"Select FIELDS TO EDIT: ",X:DTIME E W $C(7) S X="^" Q
I "^"[X Q
;I X?1."?" D:$D(P("PON")) H2,@("DISPLAY^PSJLIFN") D:'$D(P("PON")) FULL^VALM1,EFH G EFA
I X="??"&('$D(P("PON"))) D FULL^VALM1,H2 G EFA
I X?1."?" D FULL^VALM1 D:'$D(P("PON")) EFH D:$D(P("PON")) H2,@("DISPLAY^PSJLIFN") G EFA
;* I X?1."?" D EFH D:X?2."?" H2,READ^PSJUTL,@($S('$D(PSJDTYP):"ENW^PSGOEEW",PSJDTYP="OU":"ENW^PSJOEEW",PSJDTYP="O":"^PSIVORV1",1:"EN^PSIVORV2")) G EFA
I X="-"!($P("ALL",X)="") W $S(X="-":" (ALL)",1:$P("ALL",X,2)) F Q=0:0 S Q=$O(PSGEFN(Q)) Q:'Q S Y=Y_Q_","
I G FDONE
S:$E(X)="-" X=+PSGEFN_X S:$E($L(X))="-" X=X_$P(PSGEFN,":",2)
F Q=1:1:$L(X,",") S X1=$P(X,",",Q) D FS Q:'$D(X)
I '$D(X) W $C(7)," ??" G EFA
;
FDONE ;
I '$D(Y) W $C(7)," ??" G EFA
S:Y Y=$E(Y,1,$L(Y)-1) Q
;
FS ;
I $S(X1?1.N1"-"1.N:0,X1'?1.N:1,'$D(PSGEFN(X1)):1,1:","_Y[X1) K X Q
I X1'["-" S Y=Y_X1_"," Q
S X2=+X1,Y=Y_X2_"," F S X2=$O(PSGEFN(X2)) K:$S(X="":1,","_Y[X2:1,1:X2>$P(X1,"-",2)) Y Q:'$D(Y) S Y=Y_X2_"," Q:X2=$P(X1,"-",2)
Q
ENEFA2 ;
I '$D(PSGEFN) K Y S Y="" Q
S Y=$P(XQORNOD(0),"=",2)
; wasn't handling "0#" correctly, will strip off a leading zero on 1-9
N Q,X1 F Q=1:1:$L(Y,",") S X1=$P(Y,",",Q) D
.I X1?1"0"1.2N S $P(Y,",",Q)=+X1
Q
;
EFH ;
W !!?2,"Select the fields you wish to edit, by number. Only those fields with a",!,"number to the left of the field name are editable."
Q
PSGON ;BIR/CML3-SELECT ORDERS ;14-Feb-2013 11:06;PB
+1 ;;5.0; INPATIENT MEDICATIONS ;**2,22,54,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Modified - IHS/MSC/PB - 4/20/12 - Modified H2+21 to add the Stability Offset Value field to the list of fields that can be edited
+4 ; IHS/MSC/PB - 2/13/13 - Modified H2+22 to change the wording of the Beyond Use Date to Beyond Use Days and to correct the numbering sequence for the fields
ENCHK ;
+1 KILL PSGODDD
SET PSGODDD=1
SET PSGODDD(1)=""
IF X="-"
WRITE " (ALL)"
IF X="ALL"!(X="-")
SET X="1-"_PSGLMT
+2 IF '$TEST
IF $EXTRACT(X)="-"
SET X=1_X
IF $EXTRACT(X,$LENGTH(X))="-"
SET X=X_PSGLMT
+3 FOR Q=1:1:$LENGTH(X,",")
SET X1=$PIECE(X,",",Q)
DO SET
IF '$DATA(X)
QUIT
+4 QUIT
+5 ;
SET ;
+1 IF $SELECT(X1>PSGLMT:1,X1<1:1,X1?.N:0,1:X1'?1.N1"-"1.N)
KILL X
QUIT
+2 IF X1'["-"
SET X2=X1
GOTO SET1
+3 FOR X2=$PIECE(X1,"-"):1:$PIECE(X1,"-",2)
DO SET1
IF '$DATA(X)
QUIT
+4 QUIT
+5 ;
SET1 ;
+1 SET X2=+X2
IF $SELECT(X2<1:1,X2>PSGLMT:1,$DATA(PSGEFN):'$DATA(PSGEFN(X2)),1:0)
KILL X
QUIT
+2 IF PSGODDD(PSGODDD)
FOR QQ=+$GET(PSGOESF):1:PSGODDD
IF ","_$GET(PSGODDD(QQ))[(","_X2_",")
QUIT
+3 IF $TEST
QUIT
+4 IF $LENGTH(PSGODDD(PSGODDD))+$LENGTH(X2)>244
SET PSGODDD=PSGODDD+1
SET PSGODDD(PSGODDD)=""
+5 ;Q
SET PSGODDD(PSGODDD)=PSGODDD(PSGODDD)_X2_","
+6 QUIT
+7 ;
ENASR ; action/select read
+1 ;S ACTION=$S($D(PSGPRF):0,PSGONC:1,PSGONV:1,$G(PSGONF):1,1:PSGONR>0)
+2 SET ACTION=0
RD1 ;W !!,$S($D(PSGPRF):"View",1:"Select"),$S(ACTION:" ACTION or",1:"")," ORDER",$S(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),"): " R X:DTIME W:'$T $C(7) S:'$T X="^" I "^"[X K ACTION Q
+1 WRITE !!,$SELECT($DATA(PSGPRF):"View",1:"Select"),$SELECT(ACTION:" ACTION or",1:"")," ORDER",$SELECT(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),"): "
READ X:DTIME
IF '$TEST
WRITE $CHAR(7)
IF '$TEST
SET X="^"
IF X["^"
KILL ACTION
SET X="^"
QUIT
+2 IF X=""
KILL ACTION
QUIT
+3 IF X="DC"
IF ACTION
IF PSGONC
WRITE " (DISCONTINUE)"
SET X="D"
QUIT
+4 IF X="DC"
WRITE $CHAR(7)," ??"
GOTO RD1
+5 IF $PIECE("DISCONTINUE",X)=""
IF ACTION
IF PSGONC
WRITE $PIECE("DISCONTINUE",X,2)
SET X="D"
QUIT
+6 IF $PIECE("DISCONTINUE",X)=""
WRITE $CHAR(7)," ??"
GOTO RD1
+7 IF $PIECE("RENEW",X)=""
IF ACTION
IF PSGONR
WRITE $PIECE("RENEW",X,2)
SET X="R"
QUIT
+8 IF $PIECE("RENEW",X)=""
WRITE $CHAR(7)," ??"
GOTO RD1
+9 IF $PIECE("VERIFY",X)=""
IF ACTION
IF PSGONV
WRITE $PIECE("VERIFY",X,2)
SET X="V"
QUIT
+10 IF $PIECE("VERIFY",X)=""
WRITE $CHAR(7)," ??"
GOTO RD1
+11 IF $PIECE("FINISH",X)=""
IF ACTION
IF $GET(PSGONF)
WRITE $PIECE("FINISH",X,2)
SET X="F"
QUIT
+12 IF $PIECE("FINISH",X)=""
WRITE $CHAR(7)," ??"
GOTO RD1
+13 IF $SELECT(X="ALL":1,X["-":1,1:X)
DO ENCHK
IF $DATA(X)
QUIT
WRITE $CHAR(7)," ??"
GOTO RD1
+14 IF X?1."?"
DO H1
GOTO RD1
+15 WRITE $CHAR(7)," ??"
GOTO RD1
+16 ;
H1 ;
+1 DO FULL^VALM1
WRITE !!?2
IF ACTION
Begin DoDot:1
+2 WRITE "Select ACTION to take on order",$EXTRACT("s",PSGONR>1!(PSGONC>1)!(PSGONV>1)!($GET(PSGONF)>1)),!,". Select -",!
IF PSGONC
WRITE ?9,"D for DISCONTINUE",!
IF PSGONR
WRITE ?9,"R for RENEW",!
IF PSGONV
WRITE ?9,"V for VERIFY",!
IF $GET(PSGONF)
WRITE ?9,"F for FINISH",!
End DoDot:1
+3 WRITE !,"Select ORDER",$SELECT(PSGLMT>1:"S (1-"_PSGLMT,1:" (1"),") to view",$SELECT('$DATA(PSGPRF):" and/or on which to take action",1:""),"."
IF X?2."?"
DO H2
+4 NEW DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(VALM("LINES"))
DO RE^VALM4
+5 QUIT
+6 ;
ENWO ; which orders
+1 SET PSGLMT=$SELECT(PSGONW="R":PSGONR,PSGONW="V":PSGONV,1:PSGONC)
RDW ;
+1 WRITE !!,$SELECT(PSGONW="V":"VERIFY which orders",PSGONW="R":...
... $SELECT($PIECE(PSJSYSP0,"^",3):"RENEW which orders",1:"MARK which orders for RENEWAL"),1:$SELECT($PIECE(PSJSYSP0,"^",5):"DISCONTINUE which orders",1:"MARK which orders for DISCONTINUATION"))," (1-",PSGLMT,"): "
+2 READ X:DTIME
IF '$TEST
WRITE $CHAR(7)
IF '$TEST
SET X="^"
IF "^"[X
QUIT
+3 IF X?1."?"
WRITE !!?2,"Select order",$EXTRACT("s",PSGLMT>1)," to ",$SELECT(PSGONW="V":"verify",PSGONW="R":$SELECT($PIECE(PSJSYSP0,"^",3):"renew.",1:"mark for renewal."),1:$SELECT($PIECE(PSJSYSP0,"^",5):"discontinue.",1:"mark for discontinuation."))
IF X?2."?"
DO H2
GOTO RDW
+4 DO ENCHK
IF '$DATA(X)
WRITE $CHAR(7)," ??"
GOTO RDW
+5 QUIT
+6 ;
H2 ;
+1 NEW X
SET X=$SELECT($DATA(PSGEFN):"field",1:"order")
WRITE !!?2,"Select ",X,"s either singularly separated by commas (1,2,3), by a range of",!,X,"s separated by a dash (1-3), or a combination (1,2,4-6). To select all"
+2 WRITE !,X,"s, enter 'ALL' or a dash ('-'). You can also enter '-n' to select the"
+3 WRITE !,"first ",X," through the 'nth' ",X," or enter 'n-' to select the 'nth' ",X,!,"through the last ",X,". If an ",X," is selected more than once, only the first",!,"selection is used (Entering '1,2,1' would return '1,2'.)."
+4 IF $DATA(PSGEFN)
WRITE !!,?2,"Fields numbers are as follows:"
+5 IF '$DATA(P("PON"))
Begin DoDot:1
+6 IF '$DATA(PSGEFN)
QUIT
+7 NEW PS
SET PS=$SELECT($GET(PSJORD)["P":1,$GET(PSJORD)["U":2,1:2)
+8 WRITE !?3,"*(1) Orderable Item",!,?3,$SELECT(PS=1:" ",PS=2:"*"),"(2) Dosage Ordered"
+9 WRITE !?3,$SELECT(PS=1:" ",PS=2:"*"),"(3) Start",!?3,"*(4) Med Route",!?3,$SELECT(PS=1:" ",PS=2:"*"),"(5) Stop"
+10 WRITE !?3," (6) Schedule Type",!?3," (7) Self Med",!?3,"*(8) Schedule"
+11 WRITE !?3," (9) Admin Times",!?3,"*(10) Provider",!?3," (11) Special "
+12 WRITE "Instructions",!?3," (12) Dispense Drug"
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 IF '$DATA(PSGEFN)
QUIT
+15 NEW PS
SET PS=$SELECT($GET(PSJORD)["P":1,$GET(PSJORD)["V":2,1:2)
+16 WRITE !?3,$SELECT($GET(P("OT"))="F":"*",PS=1:" ",PS=2:"*"),"(1) Additives",!?3,$SELECT($GET(P("OT"))="F":"*",P(4)="P":" ",PS=1:" ",PS=2:"*"),"(2) Solutions",!?3,$SELECT(P(4)="P":" ",PS=1:" ",PS=2:"*"),"(3) Infusion Rate"
+17 WRITE !?3,$SELECT(PS=1:" ",PS=2:"*"),"(4) Start",!?3,"*(5) Med Route",!?3,$SELECT(PS=1:" ",PS=2:"*"),"(6) Stop"
+18 WRITE !?3,"*(7) Schedule",!?3," (8) Admin Times",!?3,"*(9) Provider"
+19 IF $GET(P(4))="P"!($GET(P("DTYP"))=0)
Begin DoDot:2
+20 WRITE !?3,"*(10) Orderable Item",!?3," (11) Other Print",!?3," (12) Remarks"
End DoDot:2
+21 ;line below modified to add the Stability Offset Value to the list of fields that can be edited
+22 ;E W !?3," (10) Other Print",!?3," (11) Remarks"
+23 ;IHS/MSC/PB 4/25/12 Modified to display the Beyond Use Date field in the list of fields to be edited
+24 ;ISH/MSC/PB - 2/13/13 modified the line below to change the wording of the Beyond Use line and to correct the field numbering
+25 ;E W !?3," (10) Other Print",!?3," (11) Remarks",!?3," (12) Beyond Use Days"
+26 IF '$TEST
WRITE !?3," (11) Other Print",!?3," (12) Remarks",!?3," (13) Beyond Use Days"
End DoDot:1
+27 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+28 QUIT
+29 ;
ENEFA ;
+1 NEW Q,X1,X2
IF '$DATA(PSGEFN)
KILL Y
SET Y=""
QUIT
+2 ;
EFA ;
+1 KILL Y
SET Y=""
READ !!,"Select FIELDS TO EDIT: ",X:DTIME
IF '$TEST
WRITE $CHAR(7)
SET X="^"
QUIT
+2 IF "^"[X
QUIT
+3 ;I X?1."?" D:$D(P("PON")) H2,@("DISPLAY^PSJLIFN") D:'$D(P("PON")) FULL^VALM1,EFH G EFA
+4 IF X="??"&('$DATA(P("PON")))
DO FULL^VALM1
DO H2
GOTO EFA
+5 IF X?1."?"
DO FULL^VALM1
IF '$DATA(P("PON"))
DO EFH
IF $DATA(P("PON"))
DO H2
DO @("DISPLAY^PSJLIFN")
GOTO EFA
+6 ;* I X?1."?" D EFH D:X?2."?" H2,READ^PSJUTL,@($S('$D(PSJDTYP):"ENW^PSGOEEW",PSJDTYP="OU":"ENW^PSJOEEW",PSJDTYP="O":"^PSIVORV1",1:"EN^PSIVORV2")) G EFA
+7 IF X="-"!($PIECE("ALL",X)="")
WRITE $SELECT(X="-":" (ALL)",1:$PIECE("ALL",X,2))
FOR Q=0:0
SET Q=$ORDER(PSGEFN(Q))
IF 'Q
QUIT
SET Y=Y_Q_","
+8 IF $TEST
GOTO FDONE
+9 IF $EXTRACT(X)="-"
SET X=+PSGEFN_X
IF $EXTRACT($LENGTH(X))="-"
SET X=X_$PIECE(PSGEFN,":",2)
+10 FOR Q=1:1:$LENGTH(X,",")
SET X1=$PIECE(X,",",Q)
DO FS
IF '$DATA(X)
QUIT
+11 IF '$DATA(X)
WRITE $CHAR(7)," ??"
GOTO EFA
+12 ;
FDONE ;
+1 IF '$DATA(Y)
WRITE $CHAR(7)," ??"
GOTO EFA
+2 IF Y
SET Y=$EXTRACT(Y,1,$LENGTH(Y)-1)
QUIT
+3 ;
FS ;
+1 IF $SELECT(X1?1.N1"-"1.N:0,X1'?1.N:1,'$DATA(PSGEFN(X1)):1,1:","_Y[X1)
KILL X
QUIT
+2 IF X1'["-"
SET Y=Y_X1_","
QUIT
+3 SET X2=+X1
SET Y=Y_X2_","
FOR
SET X2=$ORDER(PSGEFN(X2))
IF $SELECT(X=""
KILL Y
IF '$DATA(Y)
QUIT
SET Y=Y_X2_","
IF X2=$PIECE(X1,"-",2)
QUIT
+4 QUIT
ENEFA2 ;
+1 IF '$DATA(PSGEFN)
KILL Y
SET Y=""
QUIT
+2 SET Y=$PIECE(XQORNOD(0),"=",2)
+3 ; wasn't handling "0#" correctly, will strip off a leading zero on 1-9
+4 NEW Q,X1
FOR Q=1:1:$LENGTH(Y,",")
SET X1=$PIECE(Y,",",Q)
Begin DoDot:1
+5 IF X1?1"0"1.2N
SET $PIECE(Y,",",Q)=+X1
End DoDot:1
+6 QUIT
+7 ;
EFH ;
+1 WRITE !!?2,"Select the fields you wish to edit, by number. Only those fields with a",!,"number to the left of the field name are editable."
+2 QUIT
