- 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
