- PSGOE81 ;BIR/CML3-NON-VERIFIED ORDER EDIT (CONT.) ;10 Mar 99 / 10:55 AM
- ;;5.0; INPATIENT MEDICATIONS ;**26,50,64,58,82,110,111,136**;16 DEC 97
- ;
- 39 ; admin times
- S MSG=0,PSGF2=39 S:PSGOEEF(PSGF2) BACK="39^PSGOE81"
- A39 I $$ODD^PSGS0(PSGS0XT) G DONE
- W !,"ADMIN TIMES: "_$S(PSGAT:PSGAT_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- I X="" S:(($G(PSGS0XT)="D")&'PSGS0Y) PSGOEE=0 G DONE
- I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A39
- I PSGS0XT="D"&'$G(X) I ((",P,R,")'[(","_$G(PSGST)_",")) D G A39
- .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="@" D DEL G:%'=1 A39 S PSGAT="" G DONE
- I X?1."?" D ENHLP^PSGOEM(53.1,39) G A39
- D ENCHK^PSGS0 I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,39) G A39
- S (PSGS0Y,PSGAT)=X,PSGS0Y=PSGAT G DONE
- ;
- 8 ; special instructions
- S MSG=0,PSGF2=8 S:PSGOEEF(PSGF2) BACK="8^PSGOE81"
- A8 N DIR S DIR(0)="FO^1:180^D ^PSGSICHK",DIR("A")="SPECIAL INSTRUCTIONS",DIR("??")="^D ENHLP^PSGOEM(53.1,8)" S:$G(PSGSI)]"" DIR("B")=$P(PSGSI,"^") D ^DIR I $D(DUOUT)!$D(DTOUT) S PSGOEE=0 G DONE
- I $E(X)=U D ENFF^PSGOE82 G:Y>0 @Y G A8
- I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G A8
- I X="@" D DEL G:%'=1 A8 S PSGSI="" G DONE
- I Y="",PSGSI="" G DONE
- S PSGSI=$S(Y]"":Y,1:PSGSI),PSGSI=$$ENBCMA^PSJUTL("U") G DONE
- Q
- W !,"SPECIAL INSTRUCTIONS: "_$S(PSGSI]"":PSGSI_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- I X="" S X=PSGSI I X="" G DONE
- I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A8
- I X="@",PSGSI="" W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G A8
- I X="@" D DEL G:%'=1 A8 S PSGSI="" G DONE
- I X?1."?" D ENHLP^PSGOEM(53.1,8) G A8
- D ^PSGSICHK I '$D(X) W $C(7)," ??" S X="?" D ENHLP^PSGOEM(53.1,8) G A8
- S PSGSI=X G DONE
- ;
- 10 ; start date/time
- S MSG=0,PSGF2=10 S:PSGOEEF(PSGF2) BACK="10^PSGOE81"
- A10 ;
- K PSGSDX N DUR,DURMIN,TMPFD
- I $G(PSGORD)["P",$G(PSGP) I $$LASTREN^PSJLMPRI(PSGP,PSGORD) D Q
- . W !?5,"Start Date may not be edited at this point. " D PAUSE^VALM1
- W !,"START DATE/TIME: "_$S($P(PSGSDN,"^")]"":$P(PSGSDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- I X="",PSGSD W " "_$P(PSGSDN,"^") G DONE
- I X="P" D ENPREV^PSGDL W:'$D(X) $C(7) G:'$D(X) A10 S PSGSD=+X,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD) W " ",$P(PSGSDN,"^") G DONE
- I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(53.1,10)
- I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A10
- NEW TMPX S TMPX=X,X1=+$G(PSGLI),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
- I PSGFD<Y W $C(7),!?5,"*** THE START DATE CANNOT BE AFTER THE STOP DATE! ***",! S MSG=1 G A10
- S (PSGSDX,PSGSD,PSGNESD)=+Y,PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD)
- I $G(PSGORD)["P",$G(PSGP) S DUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,"P",1) I DUR]"" S DURMIN=$$DURMIN^PSJLIVMD(DUR) I DURMIN D
- . S TMPFD=$$FMADD^XLFDT(PSGSD,,,DURMIN) K:(TMPFD<PSGSD) TMPFD I $G(TMPFD) S PSGFD=TMPFD,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
- G DONE
- ;
- 25 ; stop date
- S MSG=0,PSGF2=25 S:PSGOEEF(PSGF2) BACK="25^PSGOE81"
- A25 ;
- K PSGFDX
- W !,"STOP DATE/TIME: "_$S($P(PSGFDN,"^")]"":$P(PSGFDN,"^")_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S PSGOEE=0 G DONE
- I X="",PSGFD W " "_$P(PSGFDN,"^") G W25
- I $E(X)="^" D ENFF^PSGOE82 G:Y>0 @Y G A25
- 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 ENE^PSGDL
- K %DT S %DT="ERTX",%DT(0)=PSGSD D ^%DT K %DT G:Y'>0 A25 S (PSGFDX,PSGFD,PSGNEFD)=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD) ; I $P(PSGNEDFD,"^",3)="O",PSGNESD'=PSGNEFD S PSGNESD=PSGNEFD,PSGSD=PSGFD
- W25 I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",! S MSG=1
- ;
- ;
- DONE ;
- ;Display Expected First Dose;BHW;PSJ*5*136
- D EFDNV^PSJUTL
- I PSGOEE G:'PSGOEEF(PSGF2) @BACK S PSGOEE=PSGOEEF(PSGF2)
- Q
- ;
- FF ; up-arrow to another field
- D ENFF^PSGOEM I Y>0,Y'=39,Y'=8,Y'=10,Y'=25 S Y=Y_"^PSGOE8"_$S("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2) S:Y=2 FB=PSGF2_"^PSGOE81"
- Q
- ;
- DEL ; delete entry
- W !?3,"SURE YOU WANT TO DELETE" S %=0 D YN^DICN I %'=1 W $C(7)," <NOTHING DELETED>"
- Q
- PSGOE81 ;BIR/CML3-NON-VERIFIED ORDER EDIT (CONT.) ;10 Mar 99 / 10:55 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**26,50,64,58,82,110,111,136**;16 DEC 97
- +2 ;
- 39 ; admin times
- +1 SET MSG=0
- SET PSGF2=39
- IF PSGOEEF(PSGF2)
- SET BACK="39^PSGOE81"
- A39 IF $$ODD^PSGS0(PSGS0XT)
- GOTO DONE
- +1 WRITE !,"ADMIN TIMES: "_$SELECT(PSGAT:PSGAT_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- IF '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +2 IF X=""
- IF (($GET(PSGS0XT)="D")&'PSGS0Y)
- SET PSGOEE=0
- GOTO DONE
- +3 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE82
- IF Y>0
- GOTO @Y
- GOTO A39
- +4 IF PSGS0XT="D"&'$GET(X)
- IF ((",P,R,")'[(","_$GET(PSGST)_","))
- Begin DoDot:1
- +5 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 A39
- +6 IF X="@"
- DO DEL
- IF %'=1
- GOTO A39
- SET PSGAT=""
- GOTO DONE
- +7 IF X?1."?"
- DO ENHLP^PSGOEM(53.1,39)
- GOTO A39
- +8 DO ENCHK^PSGS0
- IF '$DATA(X)
- WRITE $CHAR(7)," ??"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,39)
- GOTO A39
- +9 SET (PSGS0Y,PSGAT)=X
- SET PSGS0Y=PSGAT
- GOTO DONE
- +10 ;
- 8 ; special instructions
- +1 SET MSG=0
- SET PSGF2=8
- IF PSGOEEF(PSGF2)
- SET BACK="8^PSGOE81"
- A8 NEW DIR
- SET DIR(0)="FO^1:180^D ^PSGSICHK"
- SET DIR("A")="SPECIAL INSTRUCTIONS"
- SET DIR("??")="^D ENHLP^PSGOEM(53.1,8)"
- IF $GET(PSGSI)]""
- SET DIR("B")=$PIECE(PSGSI,"^")
- DO ^DIR
- IF $DATA(DUOUT)!$DATA(DTOUT)
- SET PSGOEE=0
- GOTO DONE
- +1 IF $EXTRACT(X)=U
- DO ENFF^PSGOE82
- IF Y>0
- GOTO @Y
- GOTO A8
- +2 IF X="@"
- IF PSGSI=""
- WRITE $CHAR(7)," ??"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,8)
- GOTO A8
- +3 IF X="@"
- DO DEL
- IF %'=1
- GOTO A8
- SET PSGSI=""
- GOTO DONE
- +4 IF Y=""
- IF PSGSI=""
- GOTO DONE
- +5 SET PSGSI=$SELECT(Y]"":Y,1:PSGSI)
- SET PSGSI=$$ENBCMA^PSJUTL("U")
- GOTO DONE
- +6 QUIT
- +7 WRITE !,"SPECIAL INSTRUCTIONS: "_$SELECT(PSGSI]"":PSGSI_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- IF '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +8 IF X=""
- SET X=PSGSI
- IF X=""
- GOTO DONE
- +9 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE82
- IF Y>0
- GOTO @Y
- GOTO A8
- +10 IF X="@"
- IF PSGSI=""
- WRITE $CHAR(7)," ??"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,8)
- GOTO A8
- +11 IF X="@"
- DO DEL
- IF %'=1
- GOTO A8
- SET PSGSI=""
- GOTO DONE
- +12 IF X?1."?"
- DO ENHLP^PSGOEM(53.1,8)
- GOTO A8
- +13 DO ^PSGSICHK
- IF '$DATA(X)
- WRITE $CHAR(7)," ??"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,8)
- GOTO A8
- +14 SET PSGSI=X
- GOTO DONE
- +15 ;
- 10 ; start date/time
- +1 SET MSG=0
- SET PSGF2=10
- IF PSGOEEF(PSGF2)
- SET BACK="10^PSGOE81"
- A10 ;
- +1 KILL PSGSDX
- NEW DUR,DURMIN,TMPFD
- +2 IF $GET(PSGORD)["P"
- IF $GET(PSGP)
- IF $$LASTREN^PSJLMPRI(PSGP,PSGORD)
- Begin DoDot:1
- +3 WRITE !?5,"Start Date may not be edited at this point. "
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +4 WRITE !,"START DATE/TIME: "_$SELECT($PIECE(PSGSDN,"^")]"":$PIECE(PSGSDN,"^")_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- IF '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +5 IF X=""
- IF PSGSD
- WRITE " "_$PIECE(PSGSDN,"^")
- GOTO DONE
- +6 IF X="P"
- DO ENPREV^PSGDL
- IF '$DATA(X)
- WRITE $CHAR(7)
- IF '$DATA(X)
- GOTO A10
- SET PSGSD=+X
- SET PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD)
- WRITE " ",$PIECE(PSGSDN,"^")
- GOTO DONE
- +7 IF X="@"!(X?1."?")
- IF X="@"
- WRITE $CHAR(7)," (Required)"
- IF X="@"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,10)
- +8 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE82
- IF Y>0
- GOTO @Y
- GOTO A10
- +9 NEW TMPX
- SET TMPX=X
- SET X1=+$GET(PSGLI)
- 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
- +10 IF PSGFD<Y
- WRITE $CHAR(7),!?5,"*** THE START DATE CANNOT BE AFTER THE STOP DATE! ***",!
- SET MSG=1
- GOTO A10
- +11 SET (PSGSDX,PSGSD,PSGNESD)=+Y
- SET PSGSDN=$$ENDD^PSGMI(PSGSD)_"^"_$$ENDTC^PSGMI(PSGSD)
- +12 IF $GET(PSGORD)["P"
- IF $GET(PSGP)
- SET DUR=$$GETDUR^PSJLIVMD(PSGP,+PSGORD,"P",1)
- IF DUR]""
- SET DURMIN=$$DURMIN^PSJLIVMD(DUR)
- IF DURMIN
- Begin DoDot:1
- +13 SET TMPFD=$$FMADD^XLFDT(PSGSD,,,DURMIN)
- IF (TMPFD<PSGSD)
- KILL TMPFD
- IF $GET(TMPFD)
- SET PSGFD=TMPFD
- SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
- End DoDot:1
- +14 GOTO DONE
- +15 ;
- 25 ; stop date
- +1 SET MSG=0
- SET PSGF2=25
- IF PSGOEEF(PSGF2)
- SET BACK="25^PSGOE81"
- A25 ;
- +1 KILL PSGFDX
- +2 WRITE !,"STOP DATE/TIME: "_$SELECT($PIECE(PSGFDN,"^")]"":$PIECE(PSGFDN,"^")_"// ",1:"")
- READ X:DTIME
- IF X="^"!'$TEST
- IF '$TEST
- WRITE $CHAR(7)
- SET PSGOEE=0
- GOTO DONE
- +3 IF X=""
- IF PSGFD
- WRITE " "_$PIECE(PSGFDN,"^")
- GOTO W25
- +4 IF $EXTRACT(X)="^"
- DO ENFF^PSGOE82
- IF Y>0
- GOTO @Y
- GOTO A25
- +5 IF X="@"!(X?1."?")
- IF X="@"
- WRITE $CHAR(7)," (Required)"
- IF X="@"
- SET X="?"
- DO ENHLP^PSGOEM(53.1,25)
- +6 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 ENE^PSGDL
- +7 ; I $P(PSGNEDFD,"^",3)="O",PSGNESD'=PSGNEFD S PSGNESD=PSGNEFD,PSGSD=PSGFD
- KILL %DT
- SET %DT="ERTX"
- SET %DT(0)=PSGSD
- DO ^%DT
- KILL %DT
- IF Y'>0
- GOTO A25
- SET (PSGFDX,PSGFD,PSGNEFD)=+Y
- SET PSGFDN=$$ENDD^PSGMI(PSGFD)_"^"_$$ENDTC^PSGMI(PSGFD)
- W25 IF PSGFD<PSGDT
- WRITE $CHAR(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
- SET MSG=1
- +1 ;
- +2 ;
- DONE ;
- +1 ;Display Expected First Dose;BHW;PSJ*5*136
- +2 DO EFDNV^PSJUTL
- +3 IF PSGOEE
- IF 'PSGOEEF(PSGF2)
- GOTO @BACK
- SET PSGOEE=PSGOEEF(PSGF2)
- +4 QUIT
- +5 ;
- 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_"^PSGOE8"_$SELECT("^109^13^3^7^26^"[("^"_Y_"^"):"",1:2)
- IF Y=2
- SET FB=PSGF2_"^PSGOE81"
- +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
