- ORUTL ; slc/dcm,RWF - Order utilities; ;4/24/01 17:14
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**95**Dec 17, 1997
- LOC ;;GET PT. LOCATION
- S C(1)=$S($D(ORL(2))#2:$S(ORL(2)[";":$S($D(@("^"_$P(ORL(2),";",2)_+ORL(2)_",0)")):$P(^(0),"^"),1:""),1:""),1:"")
- I 'OR4,ORVP[";DPT(",$D(ORL(2)),ORL(2) Q
- G:$L(C(1)) LOC1 S (CT,C)=0,O=1 I ORVP[";DPT(",$O(^DPT(+ORVP,"DE",0))>0 W !!,"Currently enrolled in the following clinics: ",!
- I S I=0 F L=0:0 S I=$O(^DPT(+ORVP,"DE",I)) Q:I'>0 I $D(^(I,0)) S Y=^(0) I $P(Y,"^",2)'="I",'$P(Y,"^",3) I $D(^SC(+Y,0)) S X=^(0) D
- . I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),"^",2) I $S('ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) Q
- . S CT=CT+1 W:(CT#2) !?17 W:'(CT#2) ?47 W $P(X,"^") S C=C+1,C(1)=$P(X,"^") S:C'=1 C=-1
- W !
- LOC1 S C=1 W !,"Patient Location: " W:C=1&($L(C(1))) C(1),"//" R X:DTIME G QUIT:'$T,QUIT:C'=1&(X=""),LOC:$L(X)>20!(X'?.ANP),QUIT:X[U
- S DIC("S")="I ""FI""'[$P(^(0),""^"",3),'$P($G(^(""OOS"")),""^"")",DIC=44,DIC(0)=$S(C=1&($L(C(1)))&(X=""):"EMQOZX",1:"EMQZ")
- S:X="" X=C(1) D ^DIC G LOC:X["?" S:Y>0 ORL=+Y_";SC(",ORL(0)=$S($L($P(Y(0),"^",2)):$P(Y(0),"^",2),1:$E($P(Y(0),"^"),1,4))
- K ORIA,ORRA I $D(^SC(+Y,"I")) S ORIA=+^("I"),ORRA=$P(^("I"),U,2)
- I $S('$D(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1) W $C(7)," This location has been inactivated." K ORL G LOC
- I Y<0 W " You must select a standard location." G LOC
- K DIC,C,ORIA,ORRA Q
- QUIT S OREND=1 K DIC,C Q
- READ ;;Hold screen
- I $D(IOST) Q:$E(IOST)'="C"
- W ! I $D(IOSL),$Y<(IOSL-4) G READ
- W !?5,"Press return to continue " R X:$S($D(DTIME):DTIME,1:300)
- Q
- CHKNAM(X,Y) ;Input transform to not allow certain characters
- ;X is the text to be checked, Y are the characters not allowed as sent in by the input transform of the field
- N I,J I '$D(Y) S Y="-;,=^" ;if no special characters sent in, set list to all
- F I=1:1:$L(Y) I X[($E(Y,I)) S J=1
- Q +$G(J)
- CHKMNE(X) ;Input transform to not allow use of standard Lmgr Mnemonics
- N Y
- S Y=$$UP^XLFSTR(X) ;check to make sure mnemonic isn't set to lower case of restricted entries. List Manager is case insensitive
- I Y="ADPL"!(Y="DN")!(Y="Q")!(Y="FS")!(Y="GO")!(Y="?")!(Y="??")!(Y="LS")!(Y="+")!(Y="-")!(Y="PL")!(Y="PS")!(Y="RD")!(Y="SL")!(Y="<")!(Y=">")!(Y="UP")!(Y="PI")!(Y="CWAD")!(Y="TD")!(Y="EX") Q 1
- Q 0
- ORUTL ; slc/dcm,RWF - Order utilities; ;4/24/01 17:14
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**95**Dec 17, 1997
- LOC ;;GET PT. LOCATION
- +1 SET C(1)=$SELECT($DATA(ORL(2))#2:$SELECT(ORL(2)[";":$SELECT($DATA(@("^"_$PIECE(ORL(2),";",2)_+ORL(2)_",0)")):$PIECE(^(0),"^"),1:""),1:""),1:"")
- +2 IF 'OR4
- IF ORVP[";DPT("
- IF $DATA(ORL(2))
- IF ORL(2)
- QUIT
- +3 IF $LENGTH(C(1))
- GOTO LOC1
- SET (CT,C)=0
- SET O=1
- IF ORVP[";DPT("
- IF $ORDER(^DPT(+ORVP,"DE",0))>0
- WRITE !!,"Currently enrolled in the following clinics: ",!
- +4 IF $TEST
- SET I=0
- FOR L=0:0
- SET I=$ORDER(^DPT(+ORVP,"DE",I))
- IF I'>0
- QUIT
- IF $DATA(^(I,0))
- SET Y=^(0)
- IF $PIECE(Y,"^",2)'="I"
- IF '$PIECE(Y,"^",3)
- IF $DATA(^SC(+Y,0))
- SET X=^(0)
- Begin DoDot:1
- +5 IF $DATA(^SC(+Y,"I"))
- SET ORIA=+^("I")
- SET ORRA=$PIECE(^("I"),"^",2)
- IF $SELECT('ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1)
- QUIT
- +6 SET CT=CT+1
- IF (CT#2)
- WRITE !?17
- IF '(CT#2)
- WRITE ?47
- WRITE $PIECE(X,"^")
- SET C=C+1
- SET C(1)=$PIECE(X,"^")
- IF C'=1
- SET C=-1
- End DoDot:1
- +7 WRITE !
- LOC1 SET C=1
- WRITE !,"Patient Location: "
- IF C=1&($LENGTH(C(1)))
- WRITE C(1),"//"
- READ X:DTIME
- IF '$TEST
- GOTO QUIT
- IF C'=1&(X="")
- GOTO QUIT
- IF $LENGTH(X)>20!(X'?.ANP)
- GOTO LOC
- IF X[U
- GOTO QUIT
- +1 SET DIC("S")="I ""FI""'[$P(^(0),""^"",3),'$P($G(^(""OOS"")),""^"")"
- SET DIC=44
- SET DIC(0)=$SELECT(C=1&($LENGTH(C(1)))&(X=""):"EMQOZX",1:"EMQZ")
- +2 IF X=""
- SET X=C(1)
- DO ^DIC
- IF X["?"
- GOTO LOC
- IF Y>0
- SET ORL=+Y_";SC("
- SET ORL(0)=$SELECT($LENGTH($PIECE(Y(0),"^",2)):$PIECE(Y(0),"^",2),1:$EXTRACT($PIECE(Y(0),"^"),1,4))
- +3 KILL ORIA,ORRA
- IF $DATA(^SC(+Y,"I"))
- SET ORIA=+^("I")
- SET ORRA=$PIECE(^("I"),U,2)
- +4 IF $SELECT('$DATA(ORIA):0,'ORIA:0,ORIA>DT:0,ORRA'>DT&(ORRA):0,1:1)
- WRITE $CHAR(7)," This location has been inactivated."
- KILL ORL
- GOTO LOC
- +5 IF Y<0
- WRITE " You must select a standard location."
- GOTO LOC
- +6 KILL DIC,C,ORIA,ORRA
- QUIT
- QUIT SET OREND=1
- KILL DIC,C
- QUIT
- READ ;;Hold screen
- +1 IF $DATA(IOST)
- IF $EXTRACT(IOST)'="C"
- QUIT
- +2 WRITE !
- IF $DATA(IOSL)
- IF $Y<(IOSL-4)
- GOTO READ
- +3 WRITE !?5,"Press return to continue "
- READ X:$SELECT($DATA(DTIME):DTIME,1:300)
- +4 QUIT
- CHKNAM(X,Y) ;Input transform to not allow certain characters
- +1 ;X is the text to be checked, Y are the characters not allowed as sent in by the input transform of the field
- +2 ;if no special characters sent in, set list to all
- NEW I,J
- IF '$DATA(Y)
- SET Y="-;,=^"
- +3 FOR I=1:1:$LENGTH(Y)
- IF X[($EXTRACT(Y,I))
- SET J=1
- +4 QUIT +$GET(J)
- CHKMNE(X) ;Input transform to not allow use of standard Lmgr Mnemonics
- +1 NEW Y
- +2 ;check to make sure mnemonic isn't set to lower case of restricted entries. List Manager is case insensitive
- SET Y=$$UP^XLFSTR(X)
- +3 IF Y="ADPL"!(Y="DN")!(Y="Q")!(Y="FS")!(Y="GO")!(Y="?")!(Y="??")!(Y="LS")!(Y="+")!(Y="-")!(Y="PL")!(Y="PS")!(Y="RD")!(Y="SL")!(Y="<")!(Y=">")!(Y="UP")!(Y="PI")!(Y="CWAD")!(Y="TD")!(Y="EX")
- QUIT 1
- +4 QUIT 0
