- PSIVEDT1 ;BIR/MLM-EDIT IV ORDER (CONT) ;10 Mar 98 / 2:36 PM
- ;;5.0; INPATIENT MEDICATIONS ;**3,7,41,47,50,64,58,116,110,111**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA# 2191.
- ; Reference to ^PS(51.1 is supported by DBIA# 2177.
- ;
- 10 ; Start Date
- D:'P(2)&P("IVRM")!($G(PSJREN)) ENT^PSIVCAL
- A10 I $G(P("RES"))="R" I $G(ON)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
- . Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Start Date may not be edited at this point." D PAUSE^VALM1
- I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
- .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Start Date may not be edited at this point." D PAUSE^VALM1
- S Y=P(2) X ^DD("DD") W !,"START DATE/TIME: "_$S(Y]"":Y_"// ",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(P(2)&X="") Q
- I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 10
- I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S F1=53.1,F2=10 S:X="@" X="?" D ENHLP^PSIVORC1 G A10
- K %DT S:X="" X=P(2) S %DT="ERTX" D ^%DT K %DT G:Y'>0 A10
- I $G(P("RES"))="R",(+Y<+$P($G(^PS(55,DFN,"IV",+$G(P("OLDON")),0)),U,2)) D G 10
- .; naked ref below refers to line above
- .S Y=$P(^(0),U,2) X ^DD("DD") W $C(7),!!,"Start date of order being renewed is ",Y,".",!,"Start date of renewal order must be AFTER start date of order being renewed.",!
- S X1=$G(P("LOG")),X2=-7 D C^%DTC I +Y<X W !!,"Start date/time may not be entered prior to 7 days from the order's LOGIN DATE.",! D A10
- S P(2)=+Y,PSGSDX=1
- Q
- ;
- 25 ; Stop Date
- G:$D(PSGFDX) A25
- I P("IVRM")]"",$S(P(3)<P(2):1,$G(PSIVAC)["E":0,1:1) S PSIVSITE=$G(^PS(59.5,+P("IVRM"),1)),$P(PSIVSITE,"^",20,21)=$G(^PS(59.5,+P("IVRM"),5)) D ENSTOP^PSIVCAL
- A25 I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
- .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Stop Date may not be edited at this point." D PAUSE^VALM1
- S Y=P(3) X ^DD("DD") W !,"STOP DATE/TIME: "_$S(Y]"":Y_"// ",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 Q:X=""&P(2) I $E(X)=U!(X=""&P(2)) Q
- I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 25
- I X="@"!(X["?") W $C(7)," (Required)" S F1=53.1,F2=25,X="?" D ENHLP^PSIVORC1 G A25
- K %DT S:X="" X=P(3) S %DT="ERTX" D:X'=+X ^%DT
- I X=+X,X>0,X'>2000000 G A25:'$$ENDL^PSGDL(P(9),X) D ENDL^PSIVSP
- S X=Y S:Y<1!Y'["." X="" G:Y'>0 A25 S P(3)=+Y,PSGFDX=1
- Q
- 26 ; Schedule
- I $G(P("RES"))="R" I $G(ON)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
- . Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Schedule may not be edited at this point." D PAUSE^VALM1
- I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
- .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Schedule may not be edited at this point." D PAUSE^VALM1
- W !,"SCHEDULE: ",$S(P(9)]"":P(9)_"// ",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $E(X)=U!(X="") Q
- I X="@" D DEL^PSIVEDRG S:%=1 P(9)="" G 26
- I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 26
- ;/I X?1."?"!($L(X)>22)!($L(X," ")>2) S F1=55.01,F2=.09 D ENHLP^PSIVORC1 G 26
- I X?1."?"!($L(X)>22)!($L(X," ")>3) S F1=55.01,F2=.09 D ENHLP^PSIVORC1 G 26
- S P(7)="" N PSGOES K PSGOES D EN^PSIVSP S:XT<0 X="" I $G(X)="" W $C(7),"??" G 26
- S P(9)=X,P(11)=Y,P(15)=XT
- Q
- ;
- 39 ; Admin Times
- I $G(P("RES"))="R" I $G(ON)["P",($P($G(^PS(53.1,+ON,0)),"^",24)="R") D Q
- . Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Administration times may not be edited at this point." D PAUSE^VALM1
- I $G(ON)["V"!($G(ON)["U") I $$COMPLEX^PSJOE(DFN,ON) D Q
- .Q:$G(PSJBKDR) W !!?5,"This is a Complex Order. Admin Times may not be edited at this point." D PAUSE^VALM1
- I $$ODD^PSGS0(P(9)) Q
- W !,"ADMINISTRATION TIMES: ",$S(P(11)]"":P(11)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I '($G(P(15))="D"&'DONE) I $E(X)=U!(X="") Q
- I ($G(P(15))="D"!($G(P(9))["@"))&('$G(X)!(X["@")) W $C(7)," ??" S X="?" W:(P(15)="D"!(X["@")) !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times." G 39
- I X="@" D DEL^PSIVEDRG S:%=1 P(11)="" G 39
- I X["?" S F1=55.01,F2=.12 D ENHLP^PSIVORC1 G 39
- I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 39
- ;K:X[""""!($A(X)=45) X D:$D(X) CHK^DIE(51.1,1,"",X,.X) W:$G(X)="^"!('$D(X)) $C(7)," ??" G:$G(X)="^"!('$D(X)) 39 S P(11)=X D:$G(PSIVCAL) ENT^PSIVCAL,ENSTOP^PSIVCAL K PSIVCAL
- K:X[""""!($A(X)=45) X D:$D(X) ENCHK^PSGS0 W:$G(X)="^"!('$D(X)) $C(7)," ??" G:$G(X)="^"!('$D(X)) 39 S P(11)=X D:$G(PSIVCAL) ENT^PSIVCAL,ENSTOP^PSIVCAL K PSIVCAL
- Q
- ;
- 59 ; Infusion Rate
- I $G(P("RES"))="R" I $G(ON)["P",$P($G(^PS(53.1,+ON,0)),"^",24)="R" D Q
- . Q:'$G(PSIVRENW) W !!?5,"This is a Renewal Order. Infusion Rate may not be edited at this point." D PAUSE^VALM1
- W !,"INFUSION RATE: ",$S(P(8)]"":P(8)_"//",1:"") R X:DTIME S:'$T X=U S:X=U DONE=1 I $S($E(X)=U:1,X]"":0,1:P(8)]"") Q
- I X=""&(("C^P"[P(4))!(("C^S"[P(4))&(P(5)=1))) Q
- I X="@" D DEL^PSIVEDRG S:%=1 P(8)="" G 59
- I X["???",($E(P("OT"))="I"),(PSIVAC["C") D ORFLDS G 59
- I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59
- I X]"" D ENI^PSIVSP W:'$D(X) $C(7)," ??" G:'$D(X) 59 S P(8)=X
- I P(8)="" W $C(7),!!,"An infusion rate must be entered!" G 59
- Q
- ;
- 63 ; Remarks
- N DIR S X="",DIR(0)="53.1,63" S:P("REM")]"" DIR("B")=P("REM") D ^DIR I X="^"!$D(DTOUT) S DONE=1 Q
- I X="@" D DEL^PSIVEDRG S:%=1 P("REM")="" G 63
- I X]"",$E(X)'="^" S P("REM")=X
- Q
- ;
- 64 ; Other Print Info
- N DIR S X="",DIR(0)="53.1,64" S:P("OPI")]"" DIR("B")=$P(P("OPI"),"^") D ^DIR I X="^"!$D(DTOUT) S DONE=1 Q
- I X="@" D DEL^PSIVEDRG S:%=1 P("OPI")="" G 64
- I X]"",$E(X)'="^" S P("OPI")=X,P("OPI")=$$ENBCMA^PSJUTL("V")
- Q
- ;
- ORFLDS ; Display OE/RR fields during edit.
- D FULL^VALM1
- W !!,"Orderable Item: ",$P(P("PD"),U,2),!,"Give: ",$P(P("MR"),U,2)," ",P(9),!!
- Q
- PSIVEDT1 ;BIR/MLM-EDIT IV ORDER (CONT) ;10 Mar 98 / 2:36 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**3,7,41,47,50,64,58,116,110,111**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA# 2191.
- +4 ; Reference to ^PS(51.1 is supported by DBIA# 2177.
- +5 ;
- 10 ; Start Date
- +1 IF 'P(2)&P("IVRM")!($GET(PSJREN))
- DO ENT^PSIVCAL
- A10 IF $GET(P("RES"))="R"
- IF $GET(ON)["P"
- IF $PIECE($GET(^PS(53.1,+ON,0)),"^",24)="R"
- Begin DoDot:1
- +1 IF '$GET(PSIVRENW)
- QUIT
- WRITE !!?5,"This is a Renewal Order. Start Date may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +2 IF $GET(ON)["V"!($GET(ON)["U")
- IF $$COMPLEX^PSJOE(DFN,ON)
- Begin DoDot:1
- +3 IF $GET(PSJBKDR)
- QUIT
- WRITE !!?5,"This is a Complex Order. Start Date may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +4 SET Y=P(2)
- XECUTE ^DD("DD")
- WRITE !,"START DATE/TIME: "_$SELECT(Y]"":Y_"// ",1:"")
- READ X:DTIME
- IF '$TEST
- SET X=U
- IF X=U
- SET DONE=1
- IF $EXTRACT(X)=U!(P(2)&X="")
- QUIT
- +5 IF X["???"
- IF ($EXTRACT(P("OT"))="I")
- IF (PSIVAC["C")
- DO ORFLDS
- GOTO 10
- +6 IF X="@"!(X?1."?")
- IF X="@"
- WRITE $CHAR(7)," (Required)"
- SET F1=53.1
- SET F2=10
- IF X="@"
- SET X="?"
- DO ENHLP^PSIVORC1
- GOTO A10
- +7 KILL %DT
- IF X=""
- SET X=P(2)
- SET %DT="ERTX"
- DO ^%DT
- KILL %DT
- IF Y'>0
- GOTO A10
- +8 IF $GET(P("RES"))="R"
- IF (+Y<+$PIECE($GET(^PS(55,DFN,"IV",+$GET(P("OLDON")),0)),U,2))
- Begin DoDot:1
- +9 ; naked ref below refers to line above
- +10 SET Y=$PIECE(^(0),U,2)
- XECUTE ^DD("DD")
- WRITE $CHAR(7),!!,"Start date of order being renewed is ",Y,".",!,"Start date of renewal order must be AFTER start date of order being renewed.",!
- End DoDot:1
- GOTO 10
- +11 SET X1=$GET(P("LOG"))
- SET X2=-7
- DO C^%DTC
- IF +Y<X
- WRITE !!,"Start date/time may not be entered prior to 7 days from the order's LOGIN DATE.",!
- DO A10
- +12 SET P(2)=+Y
- SET PSGSDX=1
- +13 QUIT
- +14 ;
- 25 ; Stop Date
- +1 IF $DATA(PSGFDX)
- GOTO A25
- +2 IF P("IVRM")]""
- IF $SELECT(P(3)<P(2):1,$GET(PSIVAC)["E":0,1:1)
- SET PSIVSITE=$GET(^PS(59.5,+P("IVRM"),1))
- SET $PIECE(PSIVSITE,"^",20,21)=$GET(^PS(59.5,+P("IVRM"),5))
- DO ENSTOP^PSIVCAL
- A25 IF $GET(ON)["V"!($GET(ON)["U")
- IF $$COMPLEX^PSJOE(DFN,ON)
- Begin DoDot:1
- +1 IF $GET(PSJBKDR)
- QUIT
- WRITE !!?5,"This is a Complex Order. Stop Date may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +2 SET Y=P(3)
- XECUTE ^DD("DD")
- WRITE !,"STOP DATE/TIME: "_$SELECT(Y]"":Y_"// ",1:"")
- READ X:DTIME
- IF '$TEST
- SET X=U
- IF X=U
- SET DONE=1
- IF X=""&P(2)
- QUIT
- IF $EXTRACT(X)=U!(X=""&P(2))
- QUIT
- +3 IF X["???"
- IF ($EXTRACT(P("OT"))="I")
- IF (PSIVAC["C")
- DO ORFLDS
- GOTO 25
- +4 IF X="@"!(X["?")
- WRITE $CHAR(7)," (Required)"
- SET F1=53.1
- SET F2=25
- SET X="?"
- DO ENHLP^PSIVORC1
- GOTO A25
- +5 KILL %DT
- IF X=""
- SET X=P(3)
- SET %DT="ERTX"
- IF X'=+X
- DO ^%DT
- +6 IF X=+X
- IF X>0
- IF X'>2000000
- IF '$$ENDL^PSGDL(P(9),X)
- GOTO A25
- DO ENDL^PSIVSP
- +7 SET X=Y
- IF Y<1!Y'["."
- SET X=""
- IF Y'>0
- GOTO A25
- SET P(3)=+Y
- SET PSGFDX=1
- +8 QUIT
- 26 ; Schedule
- +1 IF $GET(P("RES"))="R"
- IF $GET(ON)["P"
- IF $PIECE($GET(^PS(53.1,+ON,0)),"^",24)="R"
- Begin DoDot:1
- +2 IF '$GET(PSIVRENW)
- QUIT
- WRITE !!?5,"This is a Renewal Order. Schedule may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +3 IF $GET(ON)["V"!($GET(ON)["U")
- IF $$COMPLEX^PSJOE(DFN,ON)
- Begin DoDot:1
- +4 IF $GET(PSJBKDR)
- QUIT
- WRITE !!?5,"This is a Complex Order. Schedule may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +5 WRITE !,"SCHEDULE: ",$SELECT(P(9)]"":P(9)_"// ",1:"")
- READ X:DTIME
- IF '$TEST
- SET X=U
- IF X=U
- SET DONE=1
- IF $EXTRACT(X)=U!(X="")
- QUIT
- +6 IF X="@"
- DO DEL^PSIVEDRG
- IF %=1
- SET P(9)=""
- GOTO 26
- +7 IF X["???"
- IF ($EXTRACT(P("OT"))="I")
- IF (PSIVAC["C")
- DO ORFLDS
- GOTO 26
- +8 ;/I X?1."?"!($L(X)>22)!($L(X," ")>2) S F1=55.01,F2=.09 D ENHLP^PSIVORC1 G 26
- +9 IF X?1."?"!($LENGTH(X)>22)!($LENGTH(X," ")>3)
- SET F1=55.01
- SET F2=.09
- DO ENHLP^PSIVORC1
- GOTO 26
- +10 SET P(7)=""
- NEW PSGOES
- KILL PSGOES
- DO EN^PSIVSP
- IF XT<0
- SET X=""
- IF $GET(X)=""
- WRITE $CHAR(7),"??"
- GOTO 26
- +11 SET P(9)=X
- SET P(11)=Y
- SET P(15)=XT
- +12 QUIT
- +13 ;
- 39 ; Admin Times
- +1 IF $GET(P("RES"))="R"
- IF $GET(ON)["P"
- IF ($PIECE($GET(^PS(53.1,+ON,0)),"^",24)="R")
- Begin DoDot:1
- +2 IF '$GET(PSIVRENW)
- QUIT
- WRITE !!?5,"This is a Renewal Order. Administration times may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +3 IF $GET(ON)["V"!($GET(ON)["U")
- IF $$COMPLEX^PSJOE(DFN,ON)
- Begin DoDot:1
- +4 IF $GET(PSJBKDR)
- QUIT
- WRITE !!?5,"This is a Complex Order. Admin Times may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +5 IF $$ODD^PSGS0(P(9))
- QUIT
- +6 WRITE !,"ADMINISTRATION TIMES: ",$SELECT(P(11)]"":P(11)_"//",1:"")
- READ X:DTIME
- IF '$TEST
- SET X=U
- IF X=U
- SET DONE=1
- IF '($GET(P(15))="D"&'DONE)
- IF $EXTRACT(X)=U!(X="")
- QUIT
- +7 IF ($GET(P(15))="D"!($GET(P(9))["@"))&('$GET(X)!(X["@"))
- WRITE $CHAR(7)," ??"
- SET X="?"
- IF (P(15)="D"!(X["@"))
- WRITE !,"This is a 'DAY OF THE WEEK' schedule and MUST have admin times."
- GOTO 39
- +8 IF X="@"
- DO DEL^PSIVEDRG
- IF %=1
- SET P(11)=""
- GOTO 39
- +9 IF X["?"
- SET F1=55.01
- SET F2=.12
- DO ENHLP^PSIVORC1
- GOTO 39
- +10 IF X["???"
- IF ($EXTRACT(P("OT"))="I")
- IF (PSIVAC["C")
- DO ORFLDS
- GOTO 39
- +11 ;K:X[""""!($A(X)=45) X D:$D(X) CHK^DIE(51.1,1,"",X,.X) W:$G(X)="^"!('$D(X)) $C(7)," ??" G:$G(X)="^"!('$D(X)) 39 S P(11)=X D:$G(PSIVCAL) ENT^PSIVCAL,ENSTOP^PSIVCAL K PSIVCAL
- +12 IF X[""""!($ASCII(X)=45)
- KILL X
- IF $DATA(X)
- DO ENCHK^PSGS0
- IF $GET(X)="^"!('$DATA(X))
- WRITE $CHAR(7)," ??"
- IF $GET(X)="^"!('$DATA(X))
- GOTO 39
- SET P(11)=X
- IF $GET(PSIVCAL)
- DO ENT^PSIVCAL
- DO ENSTOP^PSIVCAL
- KILL PSIVCAL
- +13 QUIT
- +14 ;
- 59 ; Infusion Rate
- +1 IF $GET(P("RES"))="R"
- IF $GET(ON)["P"
- IF $PIECE($GET(^PS(53.1,+ON,0)),"^",24)="R"
- Begin DoDot:1
- +2 IF '$GET(PSIVRENW)
- QUIT
- WRITE !!?5,"This is a Renewal Order. Infusion Rate may not be edited at this point."
- DO PAUSE^VALM1
- End DoDot:1
- QUIT
- +3 WRITE !,"INFUSION RATE: ",$SELECT(P(8)]"":P(8)_"//",1:"")
- READ X:DTIME
- IF '$TEST
- SET X=U
- IF X=U
- SET DONE=1
- IF $SELECT($EXTRACT(X)=U:1,X]"":0,1:P(8)]"")
- QUIT
- +4 IF X=""&(("C^P"[P(4))!(("C^S"[P(4))&(P(5)=1)))
- QUIT
- +5 IF X="@"
- DO DEL^PSIVEDRG
- IF %=1
- SET P(8)=""
- GOTO 59
- +6 IF X["???"
- IF ($EXTRACT(P("OT"))="I")
- IF (PSIVAC["C")
- DO ORFLDS
- GOTO 59
- +7 IF X["?"
- SET F1=53.1
- SET F2=59
- DO ENHLP^PSIVORC1
- GOTO 59
- +8 IF X]""
- DO ENI^PSIVSP
- IF '$DATA(X)
- WRITE $CHAR(7)," ??"
- IF '$DATA(X)
- GOTO 59
- SET P(8)=X
- +9 IF P(8)=""
- WRITE $CHAR(7),!!,"An infusion rate must be entered!"
- GOTO 59
- +10 QUIT
- +11 ;
- 63 ; Remarks
- +1 NEW DIR
- SET X=""
- SET DIR(0)="53.1,63"
- IF P("REM")]""
- SET DIR("B")=P("REM")
- DO ^DIR
- IF X="^"!$DATA(DTOUT)
- SET DONE=1
- QUIT
- +2 IF X="@"
- DO DEL^PSIVEDRG
- IF %=1
- SET P("REM")=""
- GOTO 63
- +3 IF X]""
- IF $EXTRACT(X)'="^"
- SET P("REM")=X
- +4 QUIT
- +5 ;
- 64 ; Other Print Info
- +1 NEW DIR
- SET X=""
- SET DIR(0)="53.1,64"
- IF P("OPI")]""
- SET DIR("B")=$PIECE(P("OPI"),"^")
- DO ^DIR
- IF X="^"!$DATA(DTOUT)
- SET DONE=1
- QUIT
- +2 IF X="@"
- DO DEL^PSIVEDRG
- IF %=1
- SET P("OPI")=""
- GOTO 64
- +3 IF X]""
- IF $EXTRACT(X)'="^"
- SET P("OPI")=X
- SET P("OPI")=$$ENBCMA^PSJUTL("V")
- +4 QUIT
- +5 ;
- ORFLDS ; Display OE/RR fields during edit.
- +1 DO FULL^VALM1
- +2 WRITE !!,"Orderable Item: ",$PIECE(P("PD"),U,2),!,"Give: ",$PIECE(P("MR"),U,2)," ",P(9),!!
- +3 QUIT
