PSGOER0.m

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