PSGOER0 ;BIR/CML3-EDIT FIELDS FOR RENEWAL ;05 May 98 / 10:58 AM
;;5.0; INPATIENT MEDICATIONS ;**11,45,47,50,63,64,70,69,58,80,110,127,136**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA 2191.
; Reference to ^VA(200 is supported by DBIA 10060.
; Reference to ^DD(55.06 is supported by DBIA 2253.
; Reference to ^%DT is supported by DBIA 10003.
; Reference to ^DIC is supported by DBIA 10006.
;
DATE(PSGP,PSGORD,PSGDT) ;
K PSGFOK,PSJNOO S F1=55.06,PSGWLL=+$G(^PS(55,PSGP,5.1)),PSGOER0=$G(^PS(55,PSGP,5,+PSGORD,0)),PSGPDRG=+$G(^(.2)),PSGOER2=$G(^(2))
NEW XX S XX=$$ACTIVE^PSJORREN(PSGP,PSGORD) S:+XX=2 PSGPDRG=$P(XX,U,2)
I '+XX W !,"No active Orderable Item was found.",! G DONE
S (PSGNEDFD,PSGOERDP)=$P($$GTNEDFD^PSGOE7("U",PSGPDRG),U)
S PSGSCH=$P(PSGOER2,"^"),PSGST=$P(PSGOER0,"^",7),PSGS0Y=$P(PSGOER2,"^",5),PSGS0XT=$P(PSGOER2,"^",6)
S PSGOEPR=+$P(PSGOER0,"^",2),(PSGOPR,PSGPR)=$S($P(PSJSYSU,";",2):DUZ,1:+PSGOEPR)
I $G(PSJSPEED) S PSGPR=$S($P(ND,"^",2):$P(ND,"^",2),1:+PSGOEPR)
S PSGOSD=+$P(PSGOER2,"^",2) S PSGOFD=+$P(PSGOER2,"^",4),PSGPRN=$P($G(^VA(200,PSGPR,0)),"^"),PSGPRI=$S($P(PSJSYSU,";",2):0,1:$P($G(^("PS")),"^",4)),PSGRO=0 S:PSGPRI PSGPRI=PSGPRI'>DT I PSGPRI S (PSGOPR,PSGPR,PSGPRN)=""
S PSGRNSD=$S($G(PSGLI):PSGLI,1:$G(PSGDT))
S PSGSD=$G(PSGOSD)
I PSGSD="" S PSJREN=1,PSGSD=$$ENSD^PSGNE3($S(PSGST["P":"PRN",1:$P(PSGOER2,U)),PSGS0Y,PSGDT,PSGOSD) S:PSGOSD>PSGSD PSGSD=PSGOSD K PSJREN
S PSGSDN=$$ENDD^PSGMI(PSGSD)
10 ;
;W !,"START DATE/TIME: "_PSGSDN
O25 ;
N PSGSD,PSGNEFD S PSGSD=PSGDT
D ENWALL^PSGNE3(PSGSD,0,PSGP)
S:'$G(PSGDT) PSGDT=$$DATE2^PSJUTL2($$NOW^XLFDT)
N PSGNESD S PSGNESD=PSGDT D ENFD^PSGNE3(PSGNESD) I $G(PSGNEFD) S (Y,PSGFD)=PSGNEFD
S PSGFOK(10)="" I PSGST="O" S PSGFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGRNSD,PSGP) I PSGFD]"" S Y=PSGRNSD,X=0 G 1
D25 K DUR,DURMIN N PKGFLG S PKGFLG=$S(PSGORD["U":5,PSGORD["V":"IV",PSGORD["P":"P",1:"") I PKGFLG]"" S DUR=$$GETDUR^PSJLIVMD(PSGP,+$G(PSGORD),PKGFLG,1) I DUR]"" D
.S DURMIN=($$DURMIN^PSJLIVMD(DUR)\1) I DURMIN>1 S Y=$$FMADD^XLFDT(PSGRNSD,,,DURMIN) I Y>PSGRNSD S PSGFD=Y,X=0
I $P($G(PSGOER2),"^",4)>PSGFD S Y=$P(PSGOER2,"^",4)
I $G(DUR)]"",($G(PSGORD)'["P") S DURMIN=$$DURMIN^PSJLIVMD(DUR)\1 S Y=$$FMADD^XLFDT(PSGDT,,,DURMIN)
S:X&$P(PSJSYSW0,"^",7) $P(Y,".",2)=$P(PSJSYSW0,"^",7) S PSGFD=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)
25 W !,"STOP DATE/TIME: "_PSGFDN_"// " R X:DTIME I X="^"!'$T W:'$T $C(7) S:'$T X="^" S PSGRO=1,COMQUIT=1 G DONE
I X="" W " "_PSGFDN G W25
I $E(X)="^" D FF G:Y>0 @Y G 25
S PSGF2=25 I X="@"!(X?1."?") W:X="@" $C(7)," (Required)" S:X="@" X="?" D ENHLP^PSGOEM(55.06,25)
I X=+X,X>0,X'>2000000 G 25:'$$ENDL^PSGDL(PSGSCH,X) K PSGDLS S PSGDL=X,ND2=PSGOER2,$P(ND2,"^",2)=PSGRNSD W " ...dose limit..." D ENGO^PSGDL
K %DT S %DT="ERTX" D ^%DT K %DT G:Y'>0 25 S PSGFD=+Y,PSGFDN=$$ENDD^PSGMI(PSGFD)
W25 I PSGFD<PSGDT W $C(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
I PSGFD<PSGSD W $C(7),!!?3,"*** The STOP date must be AFTER the START date. ***" G 25
S PSGFOK(25)=""
;Display Expected First Dose;BHW;PSJ*5*136
D EFDNEW^PSJUTL
I $G(PSGONF),(+$G(PSGODDD(1))'<+$G(PSGONF)) S PSGFOK(1)="" Q
1 ; provider
G:+PSJSYSU<3&$P(PSJSYSU,";",2) CHKDD S PSGF2=1
A1 ;
W !,"PROVIDER: ",$S(PSGPR:PSGPRN_"// ",1:"") R X:DTIME I X="^"!'$T W:'$T $C(7) S:'$T X="^" S PSGRO=1,COMQUIT=1 G DONE
I $S(X="":'PSGPR,1:X="@") W $C(7)," (Required)" S X="?" D ENHLP^PSGOEM(55.06,1) G A1
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 CHKDD
I X?1."?" D ENHLP^PSGOEM(55.06,1)
I $E(X)="^" D FF G:Y>0 @Y G A1
K DIC S DIC="^VA(200,",DIC(0)="EMQZ",DIC("S")="S X(1)=$G(^(""PS"")) I X(1),$S('$P((X(1)),""^"",4):1,1:DT<$P((X(1)),""^"",4))" D ^DIC K DIC I Y'>0 G A1
S PSGPR=+Y,PSGPRN=$P(Y(0,0),"^"),PSGFOK(1)=""
CHKDD ;
G:$G(PSGRENEW) 106
I PSGORD["P"!$$DDOK^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",1,",PSGPDRG) G 106
;I PSGORD["P"!'$$CHKDD^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",") G 106
I $P(PSJSYSU,";")'=3,'$P(PSJSYSP0,U,2) W !!,"This order's dispense drug is invalid, a pharmacist must renew this order." Q
K ^PS(53.45,PSJSYSP,1),^(2)
W !!,"THE DISPENSE DRUG IS MISSING FROM THIS ORDER."
D ENDRG^PSGOEF1(+^PS(55,PSGP,5,+PSGORD,.2),0)
I $G(DUOUT)!'$G(DRG) S COMQUIT=1 Q
106 ; nature of order
S PSJNOO=$$ENNOO^PSJUTL5("R") S:PSJNOO<0 COMQUIT=1
S:PSJNOO'<0 PSGFOK(106)=""
DONE ;
K F,F0,F1,PSGF2,F3,ND2,PSGDL,PSGDLS,PSGOROE1,PSGRO,SDT Q
FF ; "^" to another field
K DIC S DIC="^DD(55.06,",DIC(0)="EQ",DIC("S")="I $D(PSGFOK(+Y))",X=$E(X,2,255) D ^DIC K DIC
S Y=+Y Q
PSGOER0 ;BIR/CML3-EDIT FIELDS FOR RENEWAL ;05 May 98 / 10:58 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**11,45,47,50,63,64,70,69,58,80,110,127,136**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ; Reference to ^VA(200 is supported by DBIA 10060.
+5 ; Reference to ^DD(55.06 is supported by DBIA 2253.
+6 ; Reference to ^%DT is supported by DBIA 10003.
+7 ; Reference to ^DIC is supported by DBIA 10006.
+8 ;
DATE(PSGP,PSGORD,PSGDT) ;
+1 KILL PSGFOK,PSJNOO
SET F1=55.06
SET PSGWLL=+$GET(^PS(55,PSGP,5.1))
SET PSGOER0=$GET(^PS(55,PSGP,5,+PSGORD,0))
SET PSGPDRG=+$GET(^(.2))
SET PSGOER2=$GET(^(2))
+2 NEW XX
SET XX=$$ACTIVE^PSJORREN(PSGP,PSGORD)
IF +XX=2
SET PSGPDRG=$PIECE(XX,U,2)
+3 IF '+XX
WRITE !,"No active Orderable Item was found.",!
GOTO DONE
+4 SET (PSGNEDFD,PSGOERDP)=$PIECE($$GTNEDFD^PSGOE7("U",PSGPDRG),U)
+5 SET PSGSCH=$PIECE(PSGOER2,"^")
SET PSGST=$PIECE(PSGOER0,"^",7)
SET PSGS0Y=$PIECE(PSGOER2,"^",5)
SET PSGS0XT=$PIECE(PSGOER2,"^",6)
+6 SET PSGOEPR=+$PIECE(PSGOER0,"^",2)
SET (PSGOPR,PSGPR)=$SELECT($PIECE(PSJSYSU,";",2):DUZ,1:+PSGOEPR)
+7 IF $GET(PSJSPEED)
SET PSGPR=$SELECT($PIECE(ND,"^",2):$PIECE(ND,"^",2),1:+PSGOEPR)
+8 SET PSGOSD=+$PIECE(PSGOER2,"^",2)
SET PSGOFD=+$PIECE(PSGOER2,"^",4)
SET PSGPRN=$PIECE($GET(^VA(200,PSGPR,0)),"^")
SET PSGPRI=$SELECT($PIECE(PSJSYSU,";",2):0,1:$PIECE($GET(^("PS")),"^",4))
SET PSGRO=0
IF PSGPRI
SET PSGPRI=PSGPRI'>DT
IF PSGPRI
SET (PSGOPR,PSGPR,PSGPRN)=""
+9 SET PSGRNSD=$SELECT($GET(PSGLI):PSGLI,1:$GET(PSGDT))
+10 SET PSGSD=$GET(PSGOSD)
+11 IF PSGSD=""
SET PSJREN=1
SET PSGSD=$$ENSD^PSGNE3($SELECT(PSGST["P":"PRN",1:$PIECE(PSGOER2,U)),PSGS0Y,PSGDT,PSGOSD)
IF PSGOSD>PSGSD
SET PSGSD=PSGOSD
KILL PSJREN
+12 SET PSGSDN=$$ENDD^PSGMI(PSGSD)
10 ;
+1 ;W !,"START DATE/TIME: "_PSGSDN
O25 ;
+1 NEW PSGSD,PSGNEFD
SET PSGSD=PSGDT
+2 DO ENWALL^PSGNE3(PSGSD,0,PSGP)
+3 IF '$GET(PSGDT)
SET PSGDT=$$DATE2^PSJUTL2($$NOW^XLFDT)
+4 NEW PSGNESD
SET PSGNESD=PSGDT
DO ENFD^PSGNE3(PSGNESD)
IF $GET(PSGNEFD)
SET (Y,PSGFD)=PSGNEFD
+5 SET PSGFOK(10)=""
IF PSGST="O"
SET PSGFD=$$ENOSD^PSJDCU(PSJSYSW0,PSGRNSD,PSGP)
IF PSGFD]""
SET Y=PSGRNSD
SET X=0
GOTO 1
D25 KILL DUR,DURMIN
NEW PKGFLG
SET PKGFLG=$SELECT(PSGORD["U":5,PSGORD["V":"IV",PSGORD["P":"P",1:"")
IF PKGFLG]""
SET DUR=$$GETDUR^PSJLIVMD(PSGP,+$GET(PSGORD),PKGFLG,1)
IF DUR]""
Begin DoDot:1
+1 SET DURMIN=($$DURMIN^PSJLIVMD(DUR)\1)
IF DURMIN>1
SET Y=$$FMADD^XLFDT(PSGRNSD,,,DURMIN)
IF Y>PSGRNSD
SET PSGFD=Y
SET X=0
End DoDot:1
+2 IF $PIECE($GET(PSGOER2),"^",4)>PSGFD
SET Y=$PIECE(PSGOER2,"^",4)
+3 IF $GET(DUR)]""
IF ($GET(PSGORD)'["P")
SET DURMIN=$$DURMIN^PSJLIVMD(DUR)\1
SET Y=$$FMADD^XLFDT(PSGDT,,,DURMIN)
+4 IF X&$PIECE(PSJSYSW0,"^",7)
SET $PIECE(Y,".",2)=$PIECE(PSJSYSW0,"^",7)
SET PSGFD=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)
25 WRITE !,"STOP DATE/TIME: "_PSGFDN_"// "
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
IF '$TEST
SET X="^"
SET PSGRO=1
SET COMQUIT=1
GOTO DONE
+1 IF X=""
WRITE " "_PSGFDN
GOTO W25
+2 IF $EXTRACT(X)="^"
DO FF
IF Y>0
GOTO @Y
GOTO 25
+3 SET PSGF2=25
IF X="@"!(X?1."?")
IF X="@"
WRITE $CHAR(7)," (Required)"
IF X="@"
SET X="?"
DO ENHLP^PSGOEM(55.06,25)
+4 IF X=+X
IF X>0
IF X'>2000000
IF '$$ENDL^PSGDL(PSGSCH,X)
GOTO 25
KILL PSGDLS
SET PSGDL=X
SET ND2=PSGOER2
SET $PIECE(ND2,"^",2)=PSGRNSD
WRITE " ...dose limit..."
DO ENGO^PSGDL
+5 KILL %DT
SET %DT="ERTX"
DO ^%DT
KILL %DT
IF Y'>0
GOTO 25
SET PSGFD=+Y
SET PSGFDN=$$ENDD^PSGMI(PSGFD)
W25 IF PSGFD<PSGDT
WRITE $CHAR(7),!!?13,"*** WARNING! THE STOP DATE ENTERED IS IN THE PAST! ***",!
+1 IF PSGFD<PSGSD
WRITE $CHAR(7),!!?3,"*** The STOP date must be AFTER the START date. ***"
GOTO 25
+2 SET PSGFOK(25)=""
+3 ;Display Expected First Dose;BHW;PSJ*5*136
+4 DO EFDNEW^PSJUTL
+5 IF $GET(PSGONF)
IF (+$GET(PSGODDD(1))'<+$GET(PSGONF))
SET PSGFOK(1)=""
QUIT
1 ; provider
+1 IF +PSJSYSU<3&$PIECE(PSJSYSU,";",2)
GOTO CHKDD
SET PSGF2=1
A1 ;
+1 WRITE !,"PROVIDER: ",$SELECT(PSGPR:PSGPRN_"// ",1:"")
READ X:DTIME
IF X="^"!'$TEST
IF '$TEST
WRITE $CHAR(7)
IF '$TEST
SET X="^"
SET PSGRO=1
SET COMQUIT=1
GOTO DONE
+2 IF $SELECT(X="":'PSGPR,1:X="@")
WRITE $CHAR(7)," (Required)"
SET X="?"
DO ENHLP^PSGOEM(55.06,1)
GOTO A1
+3 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 CHKDD
+4 IF X?1."?"
DO ENHLP^PSGOEM(55.06,1)
+5 IF $EXTRACT(X)="^"
DO FF
IF Y>0
GOTO @Y
GOTO A1
+6 KILL DIC
SET DIC="^VA(200,"
SET DIC(0)="EMQZ"
SET DIC("S")="S X(1)=$G(^(""PS"")) I X(1),$S('$P((X(1)),""^"",4):1,1:DT<$P((X(1)),""^"",4))"
DO ^DIC
KILL DIC
IF Y'>0
GOTO A1
+7 SET PSGPR=+Y
SET PSGPRN=$PIECE(Y(0,0),"^")
SET PSGFOK(1)=""
CHKDD ;
+1 IF $GET(PSGRENEW)
GOTO 106
+2 IF PSGORD["P"!$$DDOK^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",1,",PSGPDRG)
GOTO 106
+3 ;I PSGORD["P"!'$$CHKDD^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",") G 106
+4 IF $PIECE(PSJSYSU,";")'=3
IF '$PIECE(PSJSYSP0,U,2)
WRITE !!,"This order's dispense drug is invalid, a pharmacist must renew this order."
QUIT
+5 KILL ^PS(53.45,PSJSYSP,1),^(2)
+6 WRITE !!,"THE DISPENSE DRUG IS MISSING FROM THIS ORDER."
+7 DO ENDRG^PSGOEF1(+^PS(55,PSGP,5,+PSGORD,.2),0)
+8 IF $GET(DUOUT)!'$GET(DRG)
SET COMQUIT=1
QUIT
106 ; nature of order
+1 SET PSJNOO=$$ENNOO^PSJUTL5("R")
IF PSJNOO<0
SET COMQUIT=1
+2 IF PSJNOO'<0
SET PSGFOK(106)=""
DONE ;
+1 KILL F,F0,F1,PSGF2,F3,ND2,PSGDL,PSGDLS,PSGOROE1,PSGRO,SDT
QUIT
FF ; "^" to another field
+1 KILL DIC
SET DIC="^DD(55.06,"
SET DIC(0)="EQ"
SET DIC("S")="I $D(PSGFOK(+Y))"
SET X=$EXTRACT(X,2,255)
DO ^DIC
KILL DIC
+2 SET Y=+Y
QUIT
