PSGOE42 ;BIR/CML3-REGULAR ORDER ENTRY (CONT.) ;09 JAN 97 / 9:25 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
;
1 ; provider
I $S(+PSJSYSU=3:0,1:$P(PSJSYSU,";",2)) G:$P(PSJSYSW0,"^",24) 5 G DONE
A1 W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?",PSGF2=1 D ENHLP^PSGOEM(53.1,1) G 1
I X="",PSGPR S X=PSGPRN I PSGPR'=PSGPRN,$D(^VA(200,PSGPR,"PS")) W " "_$P(^("PS"),"^",2)_" "_$P(^("PS"),"^",3) S PSGFOK(1)="" G 5
S PSGF2=1 I X?1."?" D ENHLP^PSGOEM(53.1,1)
I $E(X)="^" D FF G:Y>0 @Y G 1
K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)" D ^DIC K DIC I Y'>0 G 1
S PSGPR=+Y,PSGPRN=$P(Y(0,0),"^"),PSGFOK(1)=""
;
5 ; self med
I '$P(PSJSYSW0,"^",24) G DONE
A5 W !,"SELF MED: " W:PSGSM]"" $P("NO^YES","^",PSGSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I "01"[X,$L(X)<2 S:PSGSM=""&(X]"") PSGSM=X W:PSGSM]"" " (",$P("NO^YES","^",PSGSM+1),")" G DONE
I X="@" W:PSGSM="" $C(7)," ??" G:PSGSM="" A5 D DEL G:%'=1 A5 S (PSGSM,PSGHSM)="" G DONE
S PSGF2=5 I X?1"^".E D FF G:Y>0 @Y G A5
I X?1."?" S PSGF2=5 D ENHLP^PSGOEM(53.1,5) G A5
D YN I S PSGSM=$E(X)="Y",PSGFOK(5)="" G 6:PSGSM,DONE
W $C(7) D ENHLP^PSGOEM(53.1,5) G A5
;
6 ; hospital supplied self med
W !,"HOSPITAL SUPPLIED SELF MED: " W:PSGHSM]"" $P("NO^YES","^",PSGHSM+1),"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I "01"[X,$L(X)<2 S:PSGHSM=""&(X]"") PSGHSM=X W:PSGHSM]"" " (",$P("NO^YES","^",PSGHSM+1),")" G DONE
I X="@" W:PSGHSM="" $C(7)," ??" G:PSGHSM="" 6 D DEL G:%'=1 6 S PSGHSM="" G DONE
S PSGF2=6 I X?1"^".E D FF G:Y>0 @Y G 6
I X?1."?" D ENHLP^PSGOEM(53.1,6) G 6
D YN I S PSGHSM=$E(X)="Y" G DONE
W $C(7) S PSGF2=6 D ENHLP^PSGOEM(53.1,6) G 6
Q
;
DONE ;
K F,F0,F1,PSGF2,F3,PSG,SDT Q
;
FF ; up-arrow to another field
D ENFF^PSGOEM I Y>0,Y'=1,Y'=5 S Y=Y_"^PSGOE4"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:1)
Q
;
DEL ; delete entry
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
Q
;
YN ; yes/no as a set of codes
I X'?.U F Y=1:1:$L(X) I $E(X,Y)?1L S X=$E(X,1,Y-1)_$C($A(X,Y)-32)_$E(X,Y+1,$L(X))
F Y="NO","YES" I $P(Y,X)="" W $P(Y,X,2) Q
Q
;
2 ; dispense drug multiple
I PSGDRG,'$D(^PS(53.45,PSJSYSP,2)) S ^(2,0)="^53.4502P^1^1",^(1,0)=PSGDRG_"^"_PSGUD
K DA,DR S DIE="^PS(53.45,",DA=PSJSYSP,DR=2,DR(2,53.4502)=$S($G(PSGFOK(13)):.02,1:".01;.02") D ^DIE
I '$O(^PS(53.45,PSJSYSP,2,0)) W $C(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!"
I $G(PSGFOK(13)) Q
G @FB
PSGOE42 ;BIR/CML3-REGULAR ORDER ENTRY (CONT.) ;09 JAN 97 / 9:25 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
+3 ;
1 ; provider
+1 IF $SELECT(+PSJSYSU=3:0,1:$PIECE(PSJSYSU,";",2))
IF $PIECE(PSJSYSW0,"^",24)
GOTO 5
GOTO DONE
A1 WRITE !,"PROVIDER: ",$SELECT(PSGPR:PSGPRN_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+1 IF $SELECT(X="":'PSGPR,1:X="@")
WRITE $CHAR(7)," (Required)"
SET X="?"
SET PSGF2=1
DO ENHLP^PSGOEM(53.1,1)
GOTO 1
+2 IF X=""
IF PSGPR
SET X=PSGPRN
IF PSGPR'=PSGPRN
IF $DATA(^VA(200,PSGPR,"PS"))
WRITE " "_$PIECE(^("PS"),"^",2)_" "_$PIECE(^("PS"),"^",3)
SET PSGFOK(1)=""
GOTO 5
+3 SET PSGF2=1
IF X?1."?"
DO ENHLP^PSGOEM(53.1,1)
+4 IF $EXTRACT(X)="^"
DO FF
IF Y>0
GOTO @Y
GOTO 1
+5 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="EMQZ"
SET DIC("S")="I $D(^(""PS"")),^(""PS""),$S('$P(^(""PS""),""^"",4):1,1:$P(^(""PS""),""^"",4)>DT)"
DO ^DIC
KILL DIC
IF Y'>0
GOTO 1
+6 SET PSGPR=+Y
SET PSGPRN=$PIECE(Y(0,0),"^")
SET PSGFOK(1)=""
+7 ;
5 ; self med
+1 IF '$PIECE(PSJSYSW0,"^",24)
GOTO DONE
A5 WRITE !,"SELF MED: "
IF PSGSM]""
WRITE $PIECE("NO^YES","^",PSGSM+1),"// "
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+1 IF "01"[X
IF $LENGTH(X)<2
IF PSGSM=""&(X]"")
SET PSGSM=X
IF PSGSM]""
WRITE " (",$PIECE("NO^YES","^",PSGSM+1),")"
GOTO DONE
+2 IF X="@"
IF PSGSM=""
WRITE $CHAR(7)," ??"
IF PSGSM=""
GOTO A5
DO DEL
IF %'=1
GOTO A5
SET (PSGSM,PSGHSM)=""
GOTO DONE
+3 SET PSGF2=5
IF X?1"^".E
DO FF
IF Y>0
GOTO @Y
GOTO A5
+4 IF X?1."?"
SET PSGF2=5
DO ENHLP^PSGOEM(53.1,5)
GOTO A5
+5 DO YN
IF $TEST
SET PSGSM=$EXTRACT(X)="Y"
SET PSGFOK(5)=""
IF PSGSM
GOTO 6
GOTO DONE
+6 WRITE $CHAR(7)
DO ENHLP^PSGOEM(53.1,5)
GOTO A5
+7 ;
6 ; hospital supplied self med
+1 WRITE !,"HOSPITAL SUPPLIED SELF MED: "
IF PSGHSM]""
WRITE $PIECE("NO^YES","^",PSGHSM+1),"// "
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+2 IF "01"[X
IF $LENGTH(X)<2
IF PSGHSM=""&(X]"")
SET PSGHSM=X
IF PSGHSM]""
WRITE " (",$PIECE("NO^YES","^",PSGHSM+1),")"
GOTO DONE
+3 IF X="@"
IF PSGHSM=""
WRITE $CHAR(7)," ??"
IF PSGHSM=""
GOTO 6
DO DEL
IF %'=1
GOTO 6
SET PSGHSM=""
GOTO DONE
+4 SET PSGF2=6
IF X?1"^".E
DO FF
IF Y>0
GOTO @Y
GOTO 6
+5 IF X?1."?"
DO ENHLP^PSGOEM(53.1,6)
GOTO 6
+6 DO YN
IF $TEST
SET PSGHSM=$EXTRACT(X)="Y"
GOTO DONE
+7 WRITE $CHAR(7)
SET PSGF2=6
DO ENHLP^PSGOEM(53.1,6)
GOTO 6
+8 QUIT
+9 ;
DONE ;
+1 KILL F,F0,F1,PSGF2,F3,PSG,SDT
QUIT
+2 ;
FF ; up-arrow to another field
+1 DO ENFF^PSGOEM
IF Y>0
IF Y'=1
IF Y'=5
SET Y=Y_"^PSGOE4"_$SELECT("^109^13^3^7^26^"[("^"_Y_"^"):"",1:1)
+2 QUIT
+3 ;
DEL ; delete entry
+1 WRITE !?3,"SURE YOU WANT TO DELETE"
SET %=0
DO YN^DICN
IF %'=1
WRITE $CHAR(7)," <NOTHING DELETED>"
+2 QUIT
+3 ;
YN ; yes/no as a set of codes
+1 IF X'?.U
FOR Y=1:1:$LENGTH(X)
IF $EXTRACT(X,Y)?1L
SET X=$EXTRACT(X,1,Y-1)_$CHAR($ASCII(X,Y)-32)_$EXTRACT(X,Y+1,$LENGTH(X))
+2 FOR Y="NO","YES"
IF $PIECE(Y,X)=""
WRITE $PIECE(Y,X,2)
QUIT
+3 QUIT
+4 ;
2 ; dispense drug multiple
+1 IF PSGDRG
IF '$DATA(^PS(53.45,PSJSYSP,2))
SET ^(2,0)="^53.4502P^1^1"
SET ^(1,0)=PSGDRG_"^"_PSGUD
+2 KILL DA,DR
SET DIE="^PS(53.45,"
SET DA=PSJSYSP
SET DR=2
SET DR(2,53.4502)=$SELECT($GET(PSGFOK(13)):.02,1:".01;.02")
DO ^DIE
+3 IF '$ORDER(^PS(53.45,PSJSYSP,2,0))
WRITE $CHAR(7),!!,"WARNING: This order must have at least one dispense drug before pharmacy can",!?9,"verify it!"
+4 IF $GET(PSGFOK(13))
QUIT
+5 GOTO @FB
