PSGOE41 ;BIR/CML3-REGULAR ORDER ENTRY (CONT.) ;09 JAN 97 / 9:13 AM
;;5.0; INPATIENT MEDICATIONS ;**50,63,64,69,58,111,136**;16 DEC 97
;
; Reference to %DT is supported by DBIA 10003.
; Reference to %DTC is supported by DBIA 10000.
; Reference to ^DICN is supported by DBIA 10009.
;
39 ; admin times
G:$P(PSGNEDFD,"^",3)="P" 8
I $$ODD^PSGS0(PSGS0XT) G 8
W !,"ADMIN TIMES: "_$S(PSGS0Y:PSGS0Y_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I X="",($G(PSGS0XT)'="D") S PSGFOK(39)="" G 8
I X="",$G(PSGS0XT)="D" I $L(PSGSCH,"@")=2,$P(PSGSCH,"@",2) S (PSGAT,PSGS0Y)=$P(PSGSCH,"@",2) G 8
S PSGF2=39 I $E(X)="^" D FF G:Y>0 @Y G 39
I (PSGS0XT="D")&('$G(X)!(X["@"&($P($G(X),"@",2)))) I ((",P,R,")'[(","_$G(PSGST)_",")) D G 39
.W $C(7)," ??" S X="?" W !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D ENHLP^PSGOEM(53.1,39)
;I X="@",'PSGS0Y!(PSGS0XT="D")!(PSGSCH["@") W $C(7)," ??" S X="?" W:PSGS0XT="D"!(PSGSCH["@") !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D ENHLP^PSGOEM(53.1,39) G 39
I X="@" D DEL G:%'=1 39 S (PSGFOK(39),PSGS0Y)="" G 8
I X?1."?" D ENHLP^PSGOEM(53.1,39) G 39
D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,39) G 39
S (PSGAT,PSGS0Y)=X,PSGFOK(39)=""
;
8 ; special instructions
W !,"SPECIAL INSTRUCTIONS: "_$S(PSGSI]"":$P(PSGSI,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I X="" S X=PSGSI I X="" S PSGFOK(8)="" G:'$G(PSGOE3) 10
S PSGF2=8 I $E(X)="^" D FF G:Y>0 @Y G 8
I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G 8
I X="@" D DEL G:%'=1 8 S (PSGFOK(8),PSGSI)="" G:'$G(PSGOE3) 10
I X?1."?" D ENHLP^PSGOEM(53.1,8) G 8
D ^PSGSICHK I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G 8
S PSGSI=X I PSGSI]"" S PSGSI=$$ENBCMA^PSJUTL("U"),PSGFOK(8)=""
Q:$G(PSGOE3)
;
10 ; start date/time
D ^PSGNE3
S:'$D(PSGNESDO) PSGNESDO=$$ENDD^PSGMI(PSGNESD) S PSGSD=PSGNESDO
A10 W !,"START DATE/TIME: "_PSGSD_"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I X="",PSGNESD W " "_PSGSD G O25
I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S PSGNESD=+X,PSGSD=$$ENDD^PSGMI(+X) W " ",PSGSD G O25
S PSGF2=10 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,10)
I $E(X)="^" D FF G:Y>0 @Y G A10
NEW TMPX S TMPX=X,X1=PSGDT,X2=-7 D C^%DTC K %DT S %DT="ERTX",%DT(0)=X,X=TMPX D ^%DT K %DT I Y'>0 D ENHLP^PSGOEM(53.1,10) G A10
S PSGNESD=+Y,PSGSD=$$ENDD^PSGMI(+Y),(PSGNEFD,PSGFD)=""
;
O25 ;
S PSGFOK(10)="" I $P(PSGNEDFD,"^",3)="O" S PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP) I PSGNEFD]"" S PSGFD=$$ENDD^PSGMI(PSGNEFD)
;
25 ; stop date
Q:$G(PSGOE3)
I 'PSGNEFD D ENFD^PSGNE3(PSGDT) S PSGFD=PSGNEFDO
A25 W !,"STOP DATE/TIME: "_$S(PSGFD]"":PSGFD_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOROE1=1 G DONE
I X="",PSGNEFD W " "_PSGFD S PSGFOK(25)="" G W25
S PSGF2=25 I $E(X)="^" D FF G:Y>0 @Y G A25
;I X=+X,(X'>0) S X="?"
I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,25)
I X=+X,(X>0),(X'>2000000) G A25:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X W " ...dose limit..." D EN1^PSGDL
K %DT S %DT="ERTX",%DT(0)=PSGNESD D ^%DT K %DT G:Y'>0 A25 S PSGNEFD=+Y,PSGFD=$$ENDD^PSGMI(+Y),PSGFOK(25)=""
W25 I PSGNEFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
;Display Expected First Dose;BHW;PSJ*5*136
D EFDNEW^PSJUTL
;
NEXT ;
;G:$S($D(PSJOERR):0,+PSJSYSU=3:1,1:'$P(PSJSYSU,";",2)) 1^PSGOE42 G:$P(PSJSYSW0,"^",24) 5^PSGOE42 G:PSGOEORF&'$P(PSJSYSU,";",2) 106^PSGOE42
G 1^PSGOE42
;
DONE ;
I PSGOROE1 K Y W $C(7)," ...order not entered..."
K F,F0,F1,PSGF2,F3,PSG,SDT Q
;
FF ; up-arrow to another field
D ENFF^PSGOEM I Y>0,Y'=39,Y'=8,Y'=10,Y'=25 S Y=Y_"^PSGOE4"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:$P(Y,U)=2 FB=PSGF2_"^PSGOE41"
Q
;
DEL ; delete entry
W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
Q
PSGOE41 ;BIR/CML3-REGULAR ORDER ENTRY (CONT.) ;09 JAN 97 / 9:13 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**50,63,64,69,58,111,136**;16 DEC 97
+2 ;
+3 ; Reference to %DT is supported by DBIA 10003.
+4 ; Reference to %DTC is supported by DBIA 10000.
+5 ; Reference to ^DICN is supported by DBIA 10009.
+6 ;
39 ; admin times
+1 IF $PIECE(PSGNEDFD,"^",3)="P"
GOTO 8
+2 IF $$ODD^PSGS0(PSGS0XT)
GOTO 8
+3 WRITE !,"ADMIN TIMES: "_$SELECT(PSGS0Y:PSGS0Y_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+4 IF X=""
IF ($GET(PSGS0XT)'="D")
SET PSGFOK(39)=""
GOTO 8
+5 IF X=""
IF $GET(PSGS0XT)="D"
IF $LENGTH(PSGSCH,"@")=2
IF $PIECE(PSGSCH,"@",2)
SET (PSGAT,PSGS0Y)=$PIECE(PSGSCH,"@",2)
GOTO 8
+6 SET PSGF2=39
IF $EXTRACT(X)="^"
DO FF
IF Y>0
GOTO @Y
GOTO 39
+7 IF (PSGS0XT="D")&('$GET(X)!(X["@"&($PIECE($GET(X),"@",2))))
IF ((",P,R,")'[(","_$GET(PSGST)_","))
Begin DoDot:1
+8 WRITE $CHAR(7)," ??"
SET X="?"
WRITE !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times."
DO ENHLP^PSGOEM(53.1,39)
End DoDot:1
GOTO 39
+9 ;I X="@",'PSGS0Y!(PSGS0XT="D")!(PSGSCH["@") W $C(7)," ??" S X="?" W:PSGS0XT="D"!(PSGSCH["@") !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." D ENHLP^PSGOEM(53.1,39) G 39
+10 IF X="@"
DO DEL
IF %'=1
GOTO 39
SET (PSGFOK(39),PSGS0Y)=""
GOTO 8
+11 IF X?1."?"
DO ENHLP^PSGOEM(53.1,39)
GOTO 39
+12 DO ENCHK^PSGS0
IF '$DATA(X)
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(53.1,39)
GOTO 39
+13 SET (PSGAT,PSGS0Y)=X
SET PSGFOK(39)=""
+14 ;
8 ; special instructions
+1 WRITE !,"SPECIAL INSTRUCTIONS: "_$SELECT(PSGSI]"":$PIECE(PSGSI,"^")_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+2 IF X=""
SET X=PSGSI
IF X=""
SET PSGFOK(8)=""
IF '$GET(PSGOE3)
GOTO 10
+3 SET PSGF2=8
IF $EXTRACT(X)="^"
DO FF
IF Y>0
GOTO @Y
GOTO 8
+4 IF X="@"
IF PSGSI=""
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(53.1,8)
GOTO 8
+5 IF X="@"
DO DEL
IF %'=1
GOTO 8
SET (PSGFOK(8),PSGSI)=""
IF '$GET(PSGOE3)
GOTO 10
+6 IF X?1."?"
DO ENHLP^PSGOEM(53.1,8)
GOTO 8
+7 DO ^PSGSICHK
IF '$DATA(X)
WRITE $CHAR(7)," ??"
SET X="?"
DO ENHLP^PSGOEM(53.1,8)
GOTO 8
+8 SET PSGSI=X
IF PSGSI]""
SET PSGSI=$$ENBCMA^PSJUTL("U")
SET PSGFOK(8)=""
+9 IF $GET(PSGOE3)
QUIT
+10 ;
10 ; start date/time
+1 DO ^PSGNE3
+2 IF '$DATA(PSGNESDO)
SET PSGNESDO=$$ENDD^PSGMI(PSGNESD)
SET PSGSD=PSGNESDO
A10 WRITE !,"START DATE/TIME: "_PSGSD_"// "
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+1 IF X=""
IF PSGNESD
WRITE " "_PSGSD
GOTO O25
+2 IF X="P"
DO ENPREV^PSGDL
IF '$DATA(X)
WRITE $CHAR(7)
IF '$DATA(X)
GOTO A10
SET PSGNESD=+X
SET PSGSD=$$ENDD^PSGMI(+X)
WRITE " ",PSGSD
GOTO O25
+3 SET PSGF2=10
IF X="@"!(X?1."?")
IF X="@"
WRITE $CHAR(7)," (Required)"
IF X="@"
SET X="?"
DO ENHLP^PSGOEM(53.1,10)
+4 IF $EXTRACT(X)="^"
DO FF
IF Y>0
GOTO @Y
GOTO A10
+5 NEW TMPX
SET TMPX=X
SET X1=PSGDT
SET X2=-7
DO C^%DTC
KILL %DT
SET %DT="ERTX"
SET %DT(0)=X
SET X=TMPX
DO ^%DT
KILL %DT
IF Y'>0
DO ENHLP^PSGOEM(53.1,10)
GOTO A10
+6 SET PSGNESD=+Y
SET PSGSD=$$ENDD^PSGMI(+Y)
SET (PSGNEFD,PSGFD)=""
+7 ;
O25 ;
+1 SET PSGFOK(10)=""
IF $PIECE(PSGNEDFD,"^",3)="O"
SET PSGNEFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGNESD,PSGP)
IF PSGNEFD]""
SET PSGFD=$$ENDD^PSGMI(PSGNEFD)
+2 ;
25 ; stop date
+1 IF $GET(PSGOE3)
QUIT
+2 IF 'PSGNEFD
DO ENFD^PSGNE3(PSGDT)
SET PSGFD=PSGNEFDO
A25 WRITE !,"STOP DATE/TIME: "_$SELECT(PSGFD]"":PSGFD_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
SET PSGOROE1=1
GOTO DONE
+1 IF X=""
IF PSGNEFD
WRITE " "_PSGFD
SET PSGFOK(25)=""
GOTO W25
+2 SET PSGF2=25
IF $EXTRACT(X)="^"
DO FF
IF Y>0
GOTO @Y
GOTO A25
+3 ;I X=+X,(X'>0) S X="?"
+4 IF X="@"!(X?1."?")
IF X="@"
WRITE $CHAR(7)," (Required)"
IF X="@"
SET X="?"
DO ENHLP^PSGOEM(53.1,25)
+5 IF X=+X
IF (X>0)
IF (X'>2000000)
IF '$$ENDL^PSGDL(PSGSCH,X)
GOTO A25
KILL PSGDLS
SET PSGDL=X
WRITE " ...dose limit..."
DO EN1^PSGDL
+6 KILL %DT
SET %DT="ERTX"
SET %DT(0)=PSGNESD
DO ^%DT
KILL %DT
IF Y'>0
GOTO A25
SET PSGNEFD=+Y
SET PSGFD=$$ENDD^PSGMI(+Y)
SET PSGFOK(25)=""
W25 IF PSGNEFD<PSGDT
WRITE $CHAR(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
+1 ;Display Expected First Dose;BHW;PSJ*5*136
+2 DO EFDNEW^PSJUTL
+3 ;
NEXT ;
+1 ;G:$S($D(PSJOERR):0,+PSJSYSU=3:1,1:'$P(PSJSYSU,";",2)) 1^PSGOE42 G:$P(PSJSYSW0,"^",24) 5^PSGOE42 G:PSGOEORF&'$P(PSJSYSU,";",2) 106^PSGOE42
+2 GOTO 1^PSGOE42
+3 ;
DONE ;
+1 IF PSGOROE1
KILL Y
WRITE $CHAR(7)," ...order not entered..."
+2 KILL F,F0,F1,PSGF2,F3,PSG,SDT
QUIT
+3 ;
FF ; up-arrow to another field
+1 DO ENFF^PSGOEM
IF Y>0
IF Y'=39
IF Y'=8
IF Y'=10
IF Y'=25
SET Y=Y_"^PSGOE4"_$SELECT("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2)
IF $PIECE(Y,U)=2
SET FB=PSGF2_"^PSGOE41"
+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
