Routine: PSIVSPDC

PSIVSPDC ;BIR/PR,MV-SPEED DC IV ORDERS ;02 Mar 99 / 9:27 AM

 ;;5.0; INPATIENT MEDICATIONS ;**23,29,38,58,110**;16 DEC 97

 ; Reference to ^PS(55 is supported by DBIA# 2191.

 ; Reference to ^PSSLOCK is supported by DBIA #2789

EN ;Loop thru to find IV ien to DC

 I $S(+PSJSYSU=3:0,+PSJSYSU=1:0,1:1) D  Q

 . W !,"You're not allowed to DC orders." D PAUSE^VALM1

 NEW ON,ON55,PSIVX,SORT,NAT,PSIVAL,PSJORD,PSGODDD,DIR

 S PSGLMT=$O(^TMP("PSIV",$J,"XB",0))-1

 S:PSGLMT<1 PSGLMT=$G(^TMP("PSJPRO",$J,0))

 Q:'+PSGLMT

 S DIR("?")="Enter the order number(s) to be Discontinued"

 S DIR(0)="L^1:"_PSGLMT,DIR("A")="DISCONTINUE which orders" D ^DIR

 S PSGODDD=Y Q:$D(DIRUT)

 ;prompt for nature of order and requesting provider

 D NATURE^PSIVOREN I '$D(P("NAT"))!'$$REQPROV^PSGOEC W !,$C(7),"No order(s) was DC." H 2 Q

 S NAT=P("NAT") D COMMENT

 N COMFLG,PSJCOM S PSJCOM=0

 S SORT="" F  S SORT=$O(^TMP("PSIV",$J,SORT)) Q:SORT=""  F PSIVX=0:0 S PSIVX=$O(^TMP("PSIV",$J,SORT,PSIVX)) Q:'PSIVX  I PSGODDD[PSIVX S ON=^(PSIVX),ON=(9999999999-ON)_$E(ON,11,11) D

 . D CHKCOM I COMFLG D PRNT Q

 . D:'PSJCOM SPDCIV

SPDCIV ;Speed DC orders

 S (PSJORD,ON55)=ON

 I ON["V",$P($G(^PS(55,DFN,"IV",+ON55,.2)),U,4)="D" W !,"             *****        DONE ORDER        *****" D PRNT Q

 I '$$LS^PSSLOCK(DFN,ON) D PRNT Q

 I ON["V" D  Q

 . S P(3)=$P($G(^PS(55,DFN,"IV",+ON55,0)),U,3)

 . D NOW^%DTC Q:P(3)<%

 . D D1^PSIVOPT2

 . S PSIVALT=1,PSIVALCK="STOP",PSIVREA="D",ON=ON55 D LOG

 . S:'$D(P("NAT")) P("NAT")=$G(PSJNOO) D HL^PSIVORA

 . D UNL^PSSLOCK(DFN,ON)

 .;;I $D(PSJNOO) S P("NAT")=PSJNOO D EN1^PSJHL2(DFN,"OC",PSJORD,"ORDER CANCELED")

 N DA,DR,DIE,PSJND S DA=+PSJORD,PSJND=$G(^PS(53.1,DA,0)),P("OLDON")=$P(PSJND,U,25),DIE="^PS(53.1,",DR="28///"_$S($P(PSJND,U,27)="E":"DE",1:"D") D ^DIE

 D HL^PSIVORA

 D UNL^PSSLOCK(DFN,ON)

COMMENT ;Ask for activity log comments.

 I $G(PSIVALT)=1,'$G(PSJUNDC) K DA,DIR S DIR(0)="55.04,.04" D ^DIR K DA,DIR S PSIVAL=$S($D(DIRUT):"",1:Y)

LOG ;Record activity log comments.

 S:$G(PSIVALT)=2 PSIVAL="Action taken using OE/RR options." D ENTACT^PSIVAL

 K DA,DIE,DR S DA(2)=DFN,DA(1)=+ON55,DA=PSIVLN,DIE="^PS(55,"_DFN_",""IV"","_+ON55_",""A"",",DR=".02////"_PSIVREA_";.03////"_$P(^VA(200,DUZ,0),U)_";.04////^S X=$G(PSIVAL)"_";.06////"_DUZ D ^DIE

 D STOP^PSIVORAL ;* Record the stop dates

PRNT ; DISPLAY IV ORDER AND PRINT MESSAGE

 N PSJLINE,PSJOC S PSJLINE=1

 D DSPLORDV^PSJLMUT1(DFN,ON)

 F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D

 .W !,$G(PSJOC(ON,X))

 W !,"             ***** NO ACTION TAKEN ON ORDER *****",!

CHKCOM ;Check to see if order is part of complex order series.

 N PSJSTAT

 S PSJCOM=$P($G(^PS(55,PSGP,"IV",+ON,.2)),U,8),COMFLG=0,PSJSTAT=$P($G(^(0)),"^",17)

 Q:'PSJCOM  I "DE"[PSJSTAT Q

 N PSJLINE,PSJOC S PSJLINE=1

 D DSPLORDV^PSJLMUT1(DFN,ON)

 W ! F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X  D

 .W !,$G(PSJOC(ON,X))

 W !,"is part of a complex order. If you discontinue this order the following orders",!,"will be discontinued too (unless the stop date has already been reached)." D CMPLX^PSJCOM1(DFN,PSJCOM,ON)

 F  W !!,"Do you want to discontinue this series of complex orders" S %=1 D YN^DICN Q:%

 I %'=1 S COMFLG=1 Q

 N O,OO S O=0,OO="" F  S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O  F  S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO=""  D  Q:COMFLG

 .Q:OO=ON  I '$$LS^PSSLOCK(DFN,OO) S COMFLG=1 Q

 Q:COMFLG

 N O,OO S O=0,OO="" F  S O=$O(^PS(55,"ACX",PSJCOM,O)) Q:'O  F  S OO=$O(^PS(55,"ACX",PSJCOM,O,OO)) Q:OO=""  D

 .I (OO["U") N PSGORD S PSGORD=OO D AC^PSGOECS

 .I (OO["V") N PSGORD S (ON,PSGORD)=OO D SPDCIV^PSIVSPDC

 .D UNL^PSSLOCK(DFN,PSGORD)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVSPDC   3621     printed  Mar 13, 2025@21:09:58                                                                                                                                                                                                    Page 2

PSIVSPDC  ;BIR/PR,MV-SPEED DC IV ORDERS ;02 Mar 99 / 9:27 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**23,29,38,58,110**;16 DEC 97

 +2       ;

 +3       ; Reference to ^PS(55 is supported by DBIA# 2191.

 +4       ; Reference to ^PSSLOCK is supported by DBIA #2789

 +5       ;

EN        ;Loop thru to find IV ien to DC

 +1        IF $SELECT(+PSJSYSU=3:0,+PSJSYSU=1:0,1:1)

               Begin DoDot:1

 +2                WRITE !,"You're not allowed to DC orders."

                   DO PAUSE^VALM1

               End DoDot:1

               QUIT

 +3        NEW ON,ON55,PSIVX,SORT,NAT,PSIVAL,PSJORD,PSGODDD,DIR

 +4        SET PSGLMT=$ORDER(^TMP("PSIV",$JOB,"XB",0))-1

 +5        if PSGLMT<1

               SET PSGLMT=$GET(^TMP("PSJPRO",$JOB,0))

 +6        if '+PSGLMT

               QUIT

 +7        SET DIR("?")="Enter the order number(s) to be Discontinued"

 +8        SET DIR(0)="L^1:"_PSGLMT

           SET DIR("A")="DISCONTINUE which orders"

           DO ^DIR

 +9        SET PSGODDD=Y

           if $DATA(DIRUT)

               QUIT

 +10      ;prompt for nature of order and requesting provider

 +11       DO NATURE^PSIVOREN

           IF '$DATA(P("NAT"))!'$$REQPROV^PSGOEC

               WRITE !,$CHAR(7),"No order(s) was DC."

               HANG 2

               QUIT

 +12       SET NAT=P("NAT")

           DO COMMENT

 +13       NEW COMFLG,PSJCOM

           SET PSJCOM=0

 +14       SET SORT=""

FOR

               SET SORT=$ORDER(^TMP("PSIV",$JOB,SORT))

               if SORT=""

                   QUIT

               FOR PSIVX=0:0

                   SET PSIVX=$ORDER(^TMP("PSIV",$JOB,SORT,PSIVX))

                   if 'PSIVX

                       QUIT

                   IF PSGODDD[PSIVX

                       SET ON=^(PSIVX)

                       SET ON=(9999999999-ON)_$EXTRACT(ON,11,11)

                       Begin DoDot:1

 +15                       DO CHKCOM

                           IF COMFLG

                               DO PRNT

                               QUIT

 +16                       if 'PSJCOM

                               DO SPDCIV

                       End DoDot:1

 +17       QUIT

SPDCIV    ;Speed DC orders

 +1        SET (PSJORD,ON55)=ON

 +2        IF ON["V"

               IF $PIECE($GET(^PS(55,DFN,"IV",+ON55,.2)),U,4)="D"

                   WRITE !,"             *****        DONE ORDER        *****"

                   DO PRNT

                   QUIT

 +3        IF '$$LS^PSSLOCK(DFN,ON)

               DO PRNT

               QUIT

 +4        IF ON["V"

               Begin DoDot:1

 +5                SET P(3)=$PIECE($GET(^PS(55,DFN,"IV",+ON55,0)),U,3)

 +6                DO NOW^%DTC

                   if P(3)<%

                       QUIT

 +7                DO D1^PSIVOPT2

 +8                SET PSIVALT=1

                   SET PSIVALCK="STOP"

                   SET PSIVREA="D"

                   SET ON=ON55

                   DO LOG

 +9                if '$DATA(P("NAT"))

                       SET P("NAT")=$GET(PSJNOO)

                   DO HL^PSIVORA

 +10               DO UNL^PSSLOCK(DFN,ON)

 +11      ;;I $D(PSJNOO) S P("NAT")=PSJNOO D EN1^PSJHL2(DFN,"OC",PSJORD,"ORDER CANCELED")

               End DoDot:1

               QUIT

 +12       NEW DA,DR,DIE,PSJND

           SET DA=+PSJORD

           SET PSJND=$GET(^PS(53.1,DA,0))

           SET P("OLDON")=$PIECE(PSJND,U,25)

           SET DIE="^PS(53.1,"

           SET DR="28///"_$SELECT($PIECE(PSJND,U,27)="E":"DE",1:"D")

           DO ^DIE

 +13       DO HL^PSIVORA

 +14       DO UNL^PSSLOCK(DFN,ON)

 +15       QUIT

COMMENT   ;Ask for activity log comments.

 +1        IF $GET(PSIVALT)=1

               IF '$GET(PSJUNDC)

                   KILL DA,DIR

                   SET DIR(0)="55.04,.04"

                   DO ^DIR

                   KILL DA,DIR

                   SET PSIVAL=$SELECT($DATA(DIRUT):"",1:Y)

 +2        QUIT

LOG       ;Record activity log comments.

 +1        if $GET(PSIVALT)=2

               SET PSIVAL="Action taken using OE/RR options."

           DO ENTACT^PSIVAL

 +2        KILL DA,DIE,DR

           SET DA(2)=DFN

           SET DA(1)=+ON55

           SET DA=PSIVLN

           SET DIE="^PS(55,"_DFN_",""IV"","_+ON55_",""A"","

           SET DR=".02////"_PSIVREA_";.03////"_$PIECE(^VA(200,DUZ,0),U)_";.04////^S X=$G(PSIVAL)"_";.06////"_DUZ

           DO ^DIE

 +3       ;* Record the stop dates

           DO STOP^PSIVORAL

 +4        QUIT

PRNT      ; DISPLAY IV ORDER AND PRINT MESSAGE

 +1        NEW PSJLINE,PSJOC

           SET PSJLINE=1

 +2        DO DSPLORDV^PSJLMUT1(DFN,ON)

 +3        FOR X=0:0

               SET X=$ORDER(PSJOC(ON,X))

               if 'X

                   QUIT

               Begin DoDot:1

 +4                WRITE !,$GET(PSJOC(ON,X))

               End DoDot:1

 +5        WRITE !,"             ***** NO ACTION TAKEN ON ORDER *****",!

 +6        QUIT

CHKCOM    ;Check to see if order is part of complex order series.

 +1        NEW PSJSTAT

 +2        SET PSJCOM=$PIECE($GET(^PS(55,PSGP,"IV",+ON,.2)),U,8)

           SET COMFLG=0

           SET PSJSTAT=$PIECE($GET(^(0)),"^",17)

 +3        if 'PSJCOM

               QUIT

           IF "DE"[PSJSTAT

               QUIT

 +4        NEW PSJLINE,PSJOC

           SET PSJLINE=1

 +5        DO DSPLORDV^PSJLMUT1(DFN,ON)

 +6        WRITE !

           FOR X=0:0

               SET X=$ORDER(PSJOC(ON,X))

               if 'X

                   QUIT

               Begin DoDot:1

 +7                WRITE !,$GET(PSJOC(ON,X))

               End DoDot:1

 +8        WRITE !,"is part of a complex order. If you discontinue this order the following orders",!,"will be discontinued too (unless the stop date has already been reached)."

           DO CMPLX^PSJCOM1(DFN,PSJCOM,ON)

 +9        FOR

               WRITE !!,"Do you want to discontinue this series of complex orders"

               SET %=1

               DO YN^DICN

               if %

                   QUIT

 +10       IF %'=1

               SET COMFLG=1

               QUIT

 +11       NEW O,OO

           SET O=0

           SET OO=""

FOR

               SET O=$ORDER(^PS(55,"ACX",PSJCOM,O))

               if 'O

                   QUIT

FOR

                   SET OO=$ORDER(^PS(55,"ACX",PSJCOM,O,OO))

                   if OO=""

                       QUIT

                   Begin DoDot:1

 +12                   if OO=ON

                           QUIT

                       IF '$$LS^PSSLOCK(DFN,OO)

                           SET COMFLG=1

                           QUIT

                   End DoDot:1

                   if COMFLG

                       QUIT

 +13       if COMFLG

               QUIT

 +14       NEW O,OO

           SET O=0

           SET OO=""

FOR

               SET O=$ORDER(^PS(55,"ACX",PSJCOM,O))

               if 'O

                   QUIT

FOR

                   SET OO=$ORDER(^PS(55,"ACX",PSJCOM,O,OO))

                   if OO=""

                       QUIT

                   Begin DoDot:1

 +15                   IF (OO["U")

                           NEW PSGORD

                           SET PSGORD=OO

                           DO AC^PSGOECS

 +16                   IF (OO["V")

                           NEW PSGORD

                           SET (ON,PSGORD)=OO

                           DO SPDCIV^PSIVSPDC

 +17                   DO UNL^PSSLOCK(DFN,PSGORD)

                   End DoDot:1

PSIVSPDC.m