Routine: PSJUTL

PSJUTL ;BIR/MLM-MISC. INPATIENT UTILITIES ;29-May-2012 14:39;PLS

 ;;5.0; INPATIENT MEDICATIONS ;**9,47,58,80,1009,110,136,157,177,134,1015**;16 DEC 97;Build 62

 ; Reference to ^DIC(42 is supported by DBIA 10039.

 ; Reference to ^PS(50.7 is supported by DBIA 2180.

 ; Reference to ^PSDRUG( is supported by DBIA 2192.

 ; Reference to ^DIC is supported by DBIA 10006.

 ; Reference to ^DIC1 is supported by DBIA 10007.

 ; Reference to ^DIR is supported by DBIA 10026.

 ; Reference to ^VALM1 is supported by DBIA 10116.

 ; Modified - IHS/MSC/PLS - 12/09/10 - Line ENOISC+8

 ; Modified - IHS/MSC/JDS - 03/12/12 - exclude home med from screening

ENDL ; device look-up

 N DA,DIC,DIE,DIX,DO,DR

 S DIC="^%ZIS(1,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q

 S X=Y(0,0)

ENDH(X) ; device help

 N D,XQH,DA,DIC,DIE,DO,DR,DZ

 S DIC="^%ZIS(1,",DIC(0)="EIM" D DO^DIC1,^DIC

READ ; hold screen

 I $D(IOST) Q:$E(IOST)'="C"

 W ! I $D(IOSL),$Y<(IOSL-4) G READ

 W !?5,"Press return to continue  " R X:$S($D(DTIME):DTIME,1:300)

ENOISC(PSJOI,USAGE) ;Set DIC("S") so that only Orderable Items with at

 ;least 1 active dispense drug for the specified usage.

 ;Input:  PSJOI IEN of Orderable Item selected

 ;        USAGE - Type of drugs (UD,IV,etc) to be selected

 ;Output: 1-At least one dispense drug found

 ;        0-None found

 N FOUND,PSJ

 S PSJ=$P($G(^PS(50.7,+PSJOI,0)),U,4),FOUND=$S('PSJ:1,PSJ>DT:1,1:0)

 I FOUND S FOUND=0 F PSJ=0:0 S PSJ=$O(^PSDRUG("ASP",PSJOI,PSJ)) Q:FOUND!'PSJ  I $P($G(^PSDRUG(PSJ,2)),U,3)[USAGE,'$G(^("I"))!($G(^("I"))'<DT) I $S(USAGE["X":1,1:$$SCREEN^APSPMULT(PSJ)) S FOUND=1  ;IHS/MSC/JDS - 12/09/10 - MDF screening

 Q FOUND

AADR ; display allergies and adverse reactions

 D ATS^PSJMUTL(60,50,1) N A,B

 I (PSGALG=0)&(PSGADR=0) W !!,"No allergies or ADRs on file."

 I PSGALG'=0 W !!,"Allergies: " S B="PSGALG" F  S A=$Q(@B) Q:A=""  W ?12,$G(@A),! S B=A

 I PSGADR'=0 W !,"      ADR: " S B="PSGADR" F  S A=$Q(@B) Q:A=""  W ?12,$G(@A),! S B=A

 D READ K PSGALG,PSGADR Q

ENALU ; application look-up

 N PSJ S PSJ=DA(1) N DA,DIC,DIE,DIX,DO,DR S DIC="^PS(50.35,",DIC(0)="EIMZ" D DO^DIC1,^DIC I Y'>0 K X Q

 S X=$P(Y(0),"^",2) K:$S(X="":1,1:$D(^PS(50.3,PSJ,1,"B",X))) X

ENAQ ; application query

 S X=DZ N D,DA,DIC,DIE,DO,DR,DZ,XQH S DIC="^PS(50.35,",DIC(0)="EIMQ" D DO^DIC1,^DIC

ENPC(PSJTYP,PSJSYSP,LEN,TEXT) ; Copy Provider Comments -> Special Instructions.

 Q:'$D(^PS(53.1,+$G(PSJORD),12,1,0)) ""

 N DIR,PSGSI,PSGOEE,X,Y

 S Y="" F X=0:0 S X=$O(^PS(53.1,+$G(PSJORD),12,X)) Q:'X  S Y=Y_^(X,0)_" " Q:$L(Y)>LEN

 S:$G(PSJTYP)'="V" Y=$$ENSET^PSGSICHK(Y) S:$G(PSJTYP)="V" Y=$E(Y,1,$L(Y)-1)

 I $L(Y)'<LEN S PSGOEE=0 D REDISP Q PSGSI

 ;Display Provider Comments Prior to Asking the Copy Provider Comments Question;BHW;PSJ*5*136

 N PSJTMP S PSJTMP=0

 W !,"PROVIDER COMMENTS:"

 F  S PSJTMP=$O(^PS(53.1,+$G(PSJORD),12,PSJTMP)) Q:'PSJTMP  W !,^PS(53.1,+$G(PSJORD),12,PSJTMP,0)

 S PSGSI=Y W ! S DIR(0)="S^Y:Yes;N:No;!:Copy and flag for display in a BCMA Message Box",DIR("A")="Copy the Provider Comments into "_$$ENFIELD(PSJTYP)_" (Yes/No/!)",DIR("??")="^D ENPCHLP1^PSJUTL(PSJTYP)" D ^DIR

 Q:Y="Y" PSGSI

 Q:Y="!" PSGSI_"^1"

 Q ""

REDISP ; Redisplay Provider Comments and allow entry of Spec. Instructions.

 D CLEAR^VALM1 F X=0:0 S X=$O(^PS(53.1,+$G(PSJORD),12,X)) Q:'X  W ^(X,0),!

 W !! S PSGSI=""

 D:PSJTYP'="V" 8^PSGOE81

 I PSJTYP="V" D 64^PSIVEDT1 S PSGSI=P("OPI")

ENPCHLP1(Y) ; Display help messages for Provider Comment copy.

 W !,"Enter ""YES"" to copy Provider Comments into the ",$$ENFIELD(Y)," field",!,"or ""NO"" to bypass",!,"or ""!"" to copy the Provider Comments into the ",$$ENFIELD(PSJTYP)," field",!,"and flag them for display in a BCMA Message Box",!!

ENPCHLP2(Y,X) ;

 W !,"The Provider Comments entered for this order are longer than the space available",!,"in the ",$$ENFIELD(Y)," field.",!!,"Enter ""YES"" to copy the first ",X-3," characters into the ",$$ENFIELD(Y),!,"field, or ""NO"" to continue.",!!

ENBCMA(PSJTYP) ;

 N DIR,X,Y

 W !!,"Would you like to flag the ",$$ENFIELD(PSJTYP)," field for display in a BCMA",!,"Message box?"

 W ! S DIR(0)="S^Y:Yes;N:No",DIR("A")="Flag the "_$$ENFIELD(PSJTYP)_" (Yes/No)" D ^DIR

 K PSJCOMSI I $G(PSJCOM),$G(PSJORD)'["P" N TEXT S TEXT=$S(PSJTYP="U":$G(PSGSI),1:$G(P("OPI"))) S PSJCOMSI=$$COMSI(PSJCOM,TEXT)

 Q:Y="Y" $S($G(PSJTYP)="U":$P(PSGSI,"^")_"^1",1:$P(P("OPI"),"^")_"^1")

 Q $S(PSJTYP="U":$P(PSGSI,"^"),1:$P($G(P("OPI")),"^"))

ENFIELD(Y) ;

 Q $S(Y="V":"Other Print Info",1:"Special Instructions")

COMSI(PARENT,INSTR) ;

 N DIR,X,Y

 W !!!!?15,"** WARNING **",!?5,"This order is part of a complex order."

 W !!,"Would you like to copy the ",$$ENFIELD(PSJTYP)

 W !,"to the other orders in the complex order?"

 S DIR(0)="S^Y:Yes;N:No",DIR("A")="     Copy the "_$$ENFIELD(PSJTYP)_" (Yes/No)" D ^DIR

 Q:Y="Y" 1

Q 0

ENORL(X) ; Return patient's location as variable ptr.

 Q $S(+$G(^DIC(42,+X,44)):+$G(^(44))_";SC(",$D(^DIC(42,+X,0)):+X_";DIC(42,",1:"")

ENMARD() ; validate MAR SELECTION DEFAULT string in WARD PARMS file.

 N PSJANS,PSJX1,PSJX2,RANGE,Q

 S RANGE="1:6" F PSJX1=1:1:6 S RANGE(PSJX1)=""

 S:$E(X)="-" X=+RANGE_X S:$E($L(X))="-" X=X_$P(RANGE,":",2)

 S PSJANS="" F Q=1:1:$L(X,",") S PSJX1=$P(X,",",Q) D FS Q:'$D(PSJANS)

 Q:'$G(PSJANS) 0

 S PSJANS=$E(PSJANS,1,$L(PSJANS)-1) F Q=1:1:$L(PSJANS,",") D  Q:'$D(PSJANS)

 .I $P(PSJANS,",",Q)=1,$L(PSJANS,",")>1 W !!,"All Medications (1) may not be selected in combination with other types." K PSJANS Q

 .W ?47,$P(PSJANS,",",Q)," - ",$P($T(@$P(PSJANS,",",Q)),";;",2),!

 S:$G(PSJANS) X=PSJANS Q $G(PSJANS)

FS ;

 I $S(PSJX1?1.N1"-"1.N:0,PSJX1'?1.N:1,'$D(RANGE(PSJX1)):1,1:","_PSJANS[PSJX1) K PSJANS Q

 I PSJX1'["-" S PSJANS=PSJANS_PSJX1_"," Q

 S PSJX2=+PSJX1,PSJANS=PSJANS_PSJX2_","

 F  S PSJX2=$O(RANGE(PSJX2)) K:$S(X="":1,","_PSJANS[PSJX2:1,1:PSJX2>$P(PSJX1,"-",2)) PSJANS Q:'$D(PSJANS)  S PSJANS=PSJANS_PSJX2_"," Q:PSJX2=$P(PSJX1,"-",2)

ENMARDH ;Help text for MAR default answer.

 W !!?2,"Enter the number corresponding to the type of orders to be included on MARs",!,"printed for this ward. Multiple types (except 1) may be selected using ""-""",!,"or "","" as delimiters.",!!,"Choose from: ",!

 N X F X=1:1:6 W !?13,X," - ",$P($T(@X),";;",2)

W !

1 ;;All Medications

2 ;;Non-IV Medications only

3 ;;IV Piggybacks

4 ;;LVPs

5 ;;TPNs

6 ;;Chemotherapy Medications (IV)

EFD ;The following EFD Tags are used to Calculate the Expected First Dose for backdoor

 ;orders.  The call to $$ENQ^PSJORP2 is used to actually perform the calculation.

 ;The program $$ENQ^PSJORP2 requires the variable INFO to equal the following:

 ;BHW;PSJ*5*136

 ; INFO (piece 1) = START DATE/TIME      ;PSGNESD (NEW ORDER)

 ; INFO (piece 2) = STOP DATE/TIME       ;PSGNEFD (NEW ORDER)

 ; INFO (piece 3) = SCHEDULE             ;PSGSCH  (NEW ORDER)

 ; INFO (piece 4) = SCHEDULE TYPE        ;PSGST   (NEW ORDER)

 ; INFO (piece 5) = ORDERABLE ITEM       ;PSGDRG  (NEW ORDER)

 ; INFO (piece 6) = ADMIN TIMES          ;PSGS0Y  (NEW ORDER)

EFDNEW ;Call Here if NEW or RENEWED Order

 N INFO

 S INFO=($G(PSGNESD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGDRG))_U_($G(PSGS0Y))

 D EFDDISP

 QUIT

EFDACT ;Call here if Editing Fields for an ACTIVE order

 ; Field 10 = Start Date

 ; Field 34 = Stop Date

 ; Field 41 = Admin Times

 N INFO,KEY,ORDER,LAST

 ;Loop Fields to be edited, in order, and determine when to Display expected first dose message

 F KEY=1:1 S ORDER=$P(PSGOEER,";",KEY) Q:'$L(ORDER)  I "10^34^41"[$P(ORDER,U,1) S ORDER(KEY)=$P(ORDER,U,1)

 ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times

 S LAST=$O(ORDER(99),-1) Q:'LAST

 ;Only display EFD once, so Quit if this call is not for the Last field in the Edit

 S LAST=ORDER(LAST)

 I LAST'=PSGF2 Q

 S INFO=($G(PSGSD))_U_($G(PSGFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y))

 D EFDDISP

 QUIT

EFDNV ;Call here if Editing Fields for a NON-VERIFIED order

 ; Field 10 = Start Date

 ; Field 25 = Stop Date

 ; Field 39 = Admin Times

 N INFO,KEY,ORDER,LAST

 ;Check if called during finish process

 I '$D(PSGOEER) D  D EFDDISP Q

 . S INFO=($G(PSGNESD))_U_($G(PSGNEFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y))

. Q

 ;Loop Fields to be edited, in order, and determine when to Display expected first dose message

 F KEY=1:1 S ORDER=$P(PSGOEER,";",KEY) Q:'$L(ORDER)  I "10^25^39"[$P(ORDER,U,1) S ORDER(KEY)=$P(ORDER,U,1)

 ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times

 S LAST=$O(ORDER(99),-1) Q:'LAST

 ;Only display EFD once, so Quit if this call is not for the Last field in the Edit

 S LAST=ORDER(LAST)

 I LAST'=PSGF2 Q

 S INFO=($G(PSGSD))_U_($G(PSGFD))_U_($G(PSGSCH))_U_($G(PSGST))_U_($G(PSGPDRG))_U_($G(PSGS0Y))

 D EFDDISP

 QUIT

EFDIV(PSGZZND) ;Set variables for EFD on IV orders.

 I $G(PSGZZND)="" D

 .N X,ZZND,LYN,PSGS0XT,PSGS0Y,PSGOES S PSGOES=1 S X=P(9) D EN^PSGS0 S:$G(ZZND)'="" PSGZZND=ZZND

 S PSGNESD=P(2),PSGNEFD=P(3),PSGSCH=P(9),PSGST=$P($G(PSGZZND),"^",5),PSGDRG=$P($G(P("PD")),"^"),PSGS0Y=P(11)

 ;BHW - PSJ*5*177 Add call to check stop date.  If it's in the past, Display Message

 D CHKSTOP

 D EFDNEW

W !

EFDDISP ;Display Expected First Dose

 N Y,Z

 Q:$G(PSGST)="OC"!($G(PSGST)="P")!($G(PSGST)="O")

 Q:$G(PSGSCH)["ON CALL"!($G(PSGSCH)["ON-CALL")!($G(PSGSCH)["ONCALL")

 Q:$G(PSGSCH)["PRN"

 I '$L($G(PSGP)) N PSGP S PSGP=""

 S Y=$$ENQ^PSJORP2(PSGP,INFO)

 I 'Y S Y="Unable to Calculate"

 X ^DD("DD")

 W !,"Expected First Dose: ",Y H 2

CHKSTOP ;BHW - PSJ*5*177 Warn user if the Stop Date is < now.

 I '+$G(P(3)) Q

 N PSNOW,%,%H,%I,X D NOW^%DTC S PSNOW=%

 I +P(3)<PSNOW D  Q

 . W !,$C(7),"The Stop Date/Time is in the Past!!!  This order will",!,"automatically EXPIRE upon Verification!!",!

. Q

PSJUTL    ;BIR/MLM-MISC. INPATIENT UTILITIES ;29-May-2012 14:39;PLS

 +1       ;;5.0; INPATIENT MEDICATIONS ;**9,47,58,80,1009,110,136,157,177,134,1015**;16 DEC 97;Build 62

 +2       ;

 +3       ; Reference to ^DIC(42 is supported by DBIA 10039.

 +4       ; Reference to ^PS(50.7 is supported by DBIA 2180.

 +5       ; Reference to ^PSDRUG( is supported by DBIA 2192.

 +6       ; Reference to ^DIC is supported by DBIA 10006.

 +7       ; Reference to ^DIC1 is supported by DBIA 10007.

 +8       ; Reference to ^DIR is supported by DBIA 10026.

 +9       ; Reference to ^VALM1 is supported by DBIA 10116.

 +10      ; Modified - IHS/MSC/PLS - 12/09/10 - Line ENOISC+8

 +11      ; Modified - IHS/MSC/JDS - 03/12/12 - exclude home med from screening

 +12      ;

ENDL      ; device look-up

 +1        NEW DA,DIC,DIE,DIX,DO,DR

 +2        SET DIC="^%ZIS(1,"

           SET DIC(0)="EIMZ"

           DO DO^DIC1

           DO ^DIC

           IF Y'>0

               KILL X

               QUIT

 +3        SET X=Y(0,0)

 +4        QUIT

 +5       ;

ENDH(X)   ; device help

 +1        NEW D,XQH,DA,DIC,DIE,DO,DR,DZ

 +2        SET DIC="^%ZIS(1,"

           SET DIC(0)="EIM"

           DO DO^DIC1

           DO ^DIC

 +3        QUIT

 +4       ;

READ      ; hold screen

 +1        IF $DATA(IOST)

               IF $EXTRACT(IOST)'="C"

                   QUIT

 +2        WRITE !

           IF $DATA(IOSL)

               IF $Y<(IOSL-4)

                   GOTO READ

 +3        WRITE !?5,"Press return to continue  "

           READ X:$SELECT($DATA(DTIME):DTIME,1:300)

 +4        QUIT

 +5       ;

ENOISC(PSJOI,USAGE) ;Set DIC("S") so that only Orderable Items with at

 +1       ;least 1 active dispense drug for the specified usage.

 +2       ;Input:  PSJOI IEN of Orderable Item selected

 +3       ;        USAGE - Type of drugs (UD,IV,etc) to be selected

 +4       ;Output: 1-At least one dispense drug found

 +5       ;        0-None found

 +6        NEW FOUND,PSJ

 +7        SET PSJ=$PIECE($GET(^PS(50.7,+PSJOI,0)),U,4)

           SET FOUND=$SELECT('PSJ:1,PSJ>DT:1,1:0)

 +8       ;IHS/MSC/JDS - 12/09/10 - MDF screening

           IF FOUND

               SET FOUND=0

               FOR PSJ=0:0

                   SET PSJ=$ORDER(^PSDRUG("ASP",PSJOI,PSJ))

                   IF FOUND!'PSJ

                       QUIT

                   IF $PIECE($GET(^PSDRUG(PSJ,2)),U,3)[USAGE

                       IF '$GET(^("I"))!($GET(^("I"))'<DT)

                           IF $SELECT(USAGE["X":1,1:$$SCREEN^APSPMULT(PSJ))

                               SET FOUND=1

 +9        QUIT FOUND

 +10      ;

AADR      ; display allergies and adverse reactions

 +1        DO ATS^PSJMUTL(60,50,1)

           NEW A,B

 +2        IF (PSGALG=0)&(PSGADR=0)

               WRITE !!,"No allergies or ADRs on file."

 +3        IF PSGALG'=0

               WRITE !!,"Allergies: "

               SET B="PSGALG"

FOR

                   SET A=$QUERY(@B)

                   IF A=""

                       QUIT

                   WRITE ?12,$GET(@A),!

                   SET B=A

 +4        IF PSGADR'=0

               WRITE !,"      ADR: "

               SET B="PSGADR"

FOR

                   SET A=$QUERY(@B)

                   IF A=""

                       QUIT

                   WRITE ?12,$GET(@A),!

                   SET B=A

 +5        DO READ

           KILL PSGALG,PSGADR

           QUIT

 +6       ;

ENALU     ; application look-up

 +1        NEW PSJ

           SET PSJ=DA(1)

           NEW DA,DIC,DIE,DIX,DO,DR

           SET DIC="^PS(50.35,"

           SET DIC(0)="EIMZ"

           DO DO^DIC1

           DO ^DIC

           IF Y'>0

               KILL X

               QUIT

 +2        SET X=$PIECE(Y(0),"^",2)

           IF $SELECT(X=""

               KILL X

 +3        QUIT

 +4       ;

ENAQ      ; application query

 +1        SET X=DZ

           NEW D,DA,DIC,DIE,DO,DR,DZ,XQH

           SET DIC="^PS(50.35,"

           SET DIC(0)="EIMQ"

           DO DO^DIC1

           DO ^DIC

 +2        QUIT

 +3       ;

ENPC(PSJTYP,PSJSYSP,LEN,TEXT) ; Copy Provider Comments -> Special Instructions.

 +1        IF '$DATA(^PS(53.1,+$GET(PSJORD),12,1,0))

               QUIT ""

 +2        NEW DIR,PSGSI,PSGOEE,X,Y

 +3        SET Y=""

           FOR X=0:0

               SET X=$ORDER(^PS(53.1,+$GET(PSJORD),12,X))

               IF 'X

                   QUIT

               SET Y=Y_^(X,0)_" "

               IF $LENGTH(Y)>LEN

                   QUIT

 +4        IF $GET(PSJTYP)'="V"

               SET Y=$$ENSET^PSGSICHK(Y)

           IF $GET(PSJTYP)="V"

               SET Y=$EXTRACT(Y,1,$LENGTH(Y)-1)

 +5        IF $LENGTH(Y)'<LEN

               SET PSGOEE=0

               DO REDISP

               QUIT PSGSI

 +6       ;Display Provider Comments Prior to Asking the Copy Provider Comments Question;BHW;PSJ*5*136

 +7        NEW PSJTMP

           SET PSJTMP=0

 +8        WRITE !,"PROVIDER COMMENTS:"

 +9        FOR

               SET PSJTMP=$ORDER(^PS(53.1,+$GET(PSJORD),12,PSJTMP))

               IF 'PSJTMP

                   QUIT

               WRITE !,^PS(53.1,+$GET(PSJORD),12,PSJTMP,0)

 +10       SET PSGSI=Y

           WRITE !

           SET DIR(0)="S^Y:Yes;N:No;!:Copy and flag for display in a BCMA Message Box"

           SET DIR("A")="Copy the Provider Comments into "_$$ENFIELD(PSJTYP)_" (Yes/No/!)"

           SET DIR("??")="^D ENPCHLP1^PSJUTL(PSJTYP)"

           DO ^DIR

 +11       IF Y="Y"

               QUIT PSGSI

 +12       IF Y="!"

               QUIT PSGSI_"^1"

 +13       QUIT ""

 +14      ;

REDISP    ; Redisplay Provider Comments and allow entry of Spec. Instructions.

 +1        DO CLEAR^VALM1

           FOR X=0:0

               SET X=$ORDER(^PS(53.1,+$GET(PSJORD),12,X))

               IF 'X

                   QUIT

               WRITE ^(X,0),!

 +2        WRITE !!

           SET PSGSI=""

 +3        IF PSJTYP'="V"

               DO 8^PSGOE81

 +4        IF PSJTYP="V"

               DO 64^PSIVEDT1

               SET PSGSI=P("OPI")

 +5        QUIT

 +6       ;

ENPCHLP1(Y) ; Display help messages for Provider Comment copy.

 +1        WRITE !,"Enter ""YES"" to copy Provider Comments into the ",$$ENFIELD(Y)," field",!,"or ""NO"" to bypass",!,"or ""!"" to copy the Provider Comments into the ",$$ENFIELD(PSJTYP)," field",!,"and flag them for display in a BCMA Message Box",!!

 +2        QUIT

ENPCHLP2(Y,X) ;

 +1        WRITE !,"The Provider Comments entered for this order are longer than the space available",!,"in the ",$$ENFIELD(Y)," field.",!!,"Enter ""YES"" to copy the first ",X-3," characters into the ",$$ENFIELD(Y),!,"field, or ""NO"" to continue.",!!

 +2        QUIT

ENBCMA(PSJTYP) ;

 +1        NEW DIR,X,Y

 +2        WRITE !!,"Would you like to flag the ",$$ENFIELD(PSJTYP)," field for display in a BCMA",!,"Message box?"

 +3        WRITE !

           SET DIR(0)="S^Y:Yes;N:No"

           SET DIR("A")="Flag the "_$$ENFIELD(PSJTYP)_" (Yes/No)"

           DO ^DIR

 +4        KILL PSJCOMSI

           IF $GET(PSJCOM)

               IF $GET(PSJORD)'["P"

                   NEW TEXT

                   SET TEXT=$SELECT(PSJTYP="U":$GET(PSGSI),1:$GET(P("OPI")))

                   SET PSJCOMSI=$$COMSI(PSJCOM,TEXT)

 +5        IF Y="Y"

               QUIT $SELECT($GET(PSJTYP)="U":$PIECE(PSGSI,"^")_"^1",1:$PIECE(P("OPI"),"^")_"^1")

 +6        QUIT $SELECT(PSJTYP="U":$PIECE(PSGSI,"^"),1:$PIECE($GET(P("OPI")),"^"))

ENFIELD(Y) ;

 +1        QUIT $SELECT(Y="V":"Other Print Info",1:"Special Instructions")

 +2       ;

COMSI(PARENT,INSTR) ;

 +1        NEW DIR,X,Y

 +2        WRITE !!!!?15,"** WARNING **",!?5,"This order is part of a complex order."

 +3        WRITE !!,"Would you like to copy the ",$$ENFIELD(PSJTYP)

 +4        WRITE !,"to the other orders in the complex order?"

 +5        SET DIR(0)="S^Y:Yes;N:No"

           SET DIR("A")="     Copy the "_$$ENFIELD(PSJTYP)_" (Yes/No)"

           DO ^DIR

 +6        IF Y="Y"

               QUIT 1

 +7        QUIT 0

 +8       ;

ENORL(X)  ; Return patient's location as variable ptr.

 +1        QUIT $SELECT(+$GET(^DIC(42,+X,44)):+$GET(^(44))_";SC(",$DATA(^DIC(42,+X,0)):+X_";DIC(42,",1:"")

 +2       ;

ENMARD()  ; validate MAR SELECTION DEFAULT string in WARD PARMS file.

 +1        NEW PSJANS,PSJX1,PSJX2,RANGE,Q

 +2        SET RANGE="1:6"

           FOR PSJX1=1:1:6

               SET RANGE(PSJX1)=""

 +3        IF $EXTRACT(X)="-"

               SET X=+RANGE_X

           IF $EXTRACT($LENGTH(X))="-"

               SET X=X_$PIECE(RANGE,":",2)

 +4        SET PSJANS=""

           FOR Q=1:1:$LENGTH(X,",")

               SET PSJX1=$PIECE(X,",",Q)

               DO FS

               IF '$DATA(PSJANS)

                   QUIT

 +5        IF '$GET(PSJANS)

               QUIT 0

 +6        SET PSJANS=$EXTRACT(PSJANS,1,$LENGTH(PSJANS)-1)

           FOR Q=1:1:$LENGTH(PSJANS,",")

               Begin DoDot:1

 +7                IF $PIECE(PSJANS,",",Q)=1

                       IF $LENGTH(PSJANS,",")>1

                           WRITE !!,"All Medications (1) may not be selected in combination with other types."

                           KILL PSJANS

                           QUIT

 +8                WRITE ?47,$PIECE(PSJANS,",",Q)," - ",$PIECE($TEXT(@$PIECE(PSJANS,",",Q)),";;",2),!

               End DoDot:1

               IF '$DATA(PSJANS)

                   QUIT

 +9        IF $GET(PSJANS)

               SET X=PSJANS

           QUIT $GET(PSJANS)

 +10      ;

FS        ;

 +1        IF $SELECT(PSJX1?1.N1"-"1.N:0,PSJX1'?1.N:1,'$DATA(RANGE(PSJX1)):1,1:","_PSJANS[PSJX1)

               KILL PSJANS

               QUIT

 +2        IF PSJX1'["-"

               SET PSJANS=PSJANS_PSJX1_","

               QUIT

 +3        SET PSJX2=+PSJX1

           SET PSJANS=PSJANS_PSJX2_","

 +4        FOR

               SET PSJX2=$ORDER(RANGE(PSJX2))

               IF $SELECT(X=""

                   KILL PSJANS

               IF '$DATA(PSJANS)

                   QUIT

               SET PSJANS=PSJANS_PSJX2_","

               IF PSJX2=$PIECE(PSJX1,"-",2)

                   QUIT

 +5        QUIT

 +6       ;

ENMARDH   ;Help text for MAR default answer.

 +1        WRITE !!?2,"Enter the number corresponding to the type of orders to be included on MARs",!,"printed for this ward. Multiple types (except 1) may be selected using ""-""",!,"or "","" as delimiters.",!!,"Choose from: ",!

 +2        NEW X

           FOR X=1:1:6

               WRITE !?13,X," - ",$PIECE($TEXT(@X),";;",2)

 +3        WRITE !

 +4        QUIT

1         ;;All Medications

2         ;;Non-IV Medications only

3         ;;IV Piggybacks

4         ;;LVPs

5         ;;TPNs

6         ;;Chemotherapy Medications (IV)

 +1       ;

EFD       ;The following EFD Tags are used to Calculate the Expected First Dose for backdoor

 +1       ;orders.  The call to $$ENQ^PSJORP2 is used to actually perform the calculation.

 +2       ;The program $$ENQ^PSJORP2 requires the variable INFO to equal the following:

 +3       ;BHW;PSJ*5*136

 +4       ; INFO (piece 1) = START DATE/TIME      ;PSGNESD (NEW ORDER)

 +5       ; INFO (piece 2) = STOP DATE/TIME       ;PSGNEFD (NEW ORDER)

 +6       ; INFO (piece 3) = SCHEDULE             ;PSGSCH  (NEW ORDER)

 +7       ; INFO (piece 4) = SCHEDULE TYPE        ;PSGST   (NEW ORDER)

 +8       ; INFO (piece 5) = ORDERABLE ITEM       ;PSGDRG  (NEW ORDER)

 +9       ; INFO (piece 6) = ADMIN TIMES          ;PSGS0Y  (NEW ORDER)

 +10      ;

EFDNEW    ;Call Here if NEW or RENEWED Order

 +1        NEW INFO

 +2        SET INFO=($GET(PSGNESD))_U_($GET(PSGNEFD))_U_($GET(PSGSCH))_U_($GET(PSGST))_U_($GET(PSGDRG))_U_($GET(PSGS0Y))

 +3        DO EFDDISP

 +4        QUIT

EFDACT    ;Call here if Editing Fields for an ACTIVE order

 +1       ; Field 10 = Start Date

 +2       ; Field 34 = Stop Date

 +3       ; Field 41 = Admin Times

 +4        NEW INFO,KEY,ORDER,LAST

 +5       ;Loop Fields to be edited, in order, and determine when to Display expected first dose message

 +6        FOR KEY=1:1

               SET ORDER=$PIECE(PSGOEER,";",KEY)

               IF '$LENGTH(ORDER)

                   QUIT

               IF "10^34^41"[$PIECE(ORDER,U,1)

                   SET ORDER(KEY)=$PIECE(ORDER,U,1)

 +7       ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times

 +8        SET LAST=$ORDER(ORDER(99),-1)

           IF 'LAST

               QUIT

 +9       ;Only display EFD once, so Quit if this call is not for the Last field in the Edit

 +10       SET LAST=ORDER(LAST)

 +11       IF LAST'=PSGF2

               QUIT

 +12       SET INFO=($GET(PSGSD))_U_($GET(PSGFD))_U_($GET(PSGSCH))_U_($GET(PSGST))_U_($GET(PSGPDRG))_U_($GET(PSGS0Y))

 +13       DO EFDDISP

 +14       QUIT

EFDNV     ;Call here if Editing Fields for a NON-VERIFIED order

 +1       ; Field 10 = Start Date

 +2       ; Field 25 = Stop Date

 +3       ; Field 39 = Admin Times

 +4        NEW INFO,KEY,ORDER,LAST

 +5       ;Check if called during finish process

 +6        IF '$DATA(PSGOEER)

               Begin DoDot:1

 +7                SET INFO=($GET(PSGNESD))_U_($GET(PSGNEFD))_U_($GET(PSGSCH))_U_($GET(PSGST))_U_($GET(PSGPDRG))_U_($GET(PSGS0Y))

 +8                QUIT

               End DoDot:1

               DO EFDDISP

               QUIT

 +9       ;Loop Fields to be edited, in order, and determine when to Display expected first dose message

 +10       FOR KEY=1:1

               SET ORDER=$PIECE(PSGOEER,";",KEY)

               IF '$LENGTH(ORDER)

                   QUIT

               IF "10^25^39"[$PIECE(ORDER,U,1)

                   SET ORDER(KEY)=$PIECE(ORDER,U,1)

 +11      ;If there are no entries in ORDER, then were Not Editing Start/Stop or Admin Times

 +12       SET LAST=$ORDER(ORDER(99),-1)

           IF 'LAST

               QUIT

 +13      ;Only display EFD once, so Quit if this call is not for the Last field in the Edit

 +14       SET LAST=ORDER(LAST)

 +15       IF LAST'=PSGF2

               QUIT

 +16       SET INFO=($GET(PSGSD))_U_($GET(PSGFD))_U_($GET(PSGSCH))_U_($GET(PSGST))_U_($GET(PSGPDRG))_U_($GET(PSGS0Y))

 +17       DO EFDDISP

 +18       QUIT

EFDIV(PSGZZND) ;Set variables for EFD on IV orders.

 +1        IF $GET(PSGZZND)=""

               Begin DoDot:1

 +2                NEW X,ZZND,LYN,PSGS0XT,PSGS0Y,PSGOES

                   SET PSGOES=1

                   SET X=P(9)

                   DO EN^PSGS0

                   IF $GET(ZZND)'=""

                       SET PSGZZND=ZZND

               End DoDot:1

 +3        SET PSGNESD=P(2)

           SET PSGNEFD=P(3)

           SET PSGSCH=P(9)

           SET PSGST=$PIECE($GET(PSGZZND),"^",5)

           SET PSGDRG=$PIECE($GET(P("PD")),"^")

           SET PSGS0Y=P(11)

 +4       ;BHW - PSJ*5*177 Add call to check stop date.  If it's in the past, Display Message

 +5        DO CHKSTOP

 +6        DO EFDNEW

 +7        WRITE !

 +8        QUIT

EFDDISP   ;Display Expected First Dose

 +1        NEW Y,Z

 +2        IF $GET(PSGST)="OC"!($GET(PSGST)="P")!($GET(PSGST)="O")

               QUIT

 +3        IF $GET(PSGSCH)["ON CALL"!($GET(PSGSCH)["ON-CALL")!($GET(PSGSCH)["ONCALL")

               QUIT

 +4        IF $GET(PSGSCH)["PRN"

               QUIT

 +5        IF '$LENGTH($GET(PSGP))

               NEW PSGP

               SET PSGP=""

 +6        SET Y=$$ENQ^PSJORP2(PSGP,INFO)

 +7        IF 'Y

               SET Y="Unable to Calculate"

 +8        XECUTE ^DD("DD")

 +9        WRITE !,"Expected First Dose: ",Y

           HANG 2

 +10       QUIT

CHKSTOP   ;BHW - PSJ*5*177 Warn user if the Stop Date is < now.

 +1        IF '+$GET(P(3))

               QUIT

 +2        NEW PSNOW,%,%H,%I,X

           DO NOW^%DTC

           SET PSNOW=%

 +3        IF +P(3)<PSNOW

               Begin DoDot:1

 +4                WRITE !,$CHAR(7),"The Stop Date/Time is in the Past!!!  This order will",!,"automatically EXPIRE upon Verification!!",!

 +5                QUIT

               End DoDot:1

               QUIT

 +6        QUIT

PSJUTL.m