- PSGOESF ;BIR/MLM-SPEED FINISH ORDERS ENTERED THROUGH OE/RR ;10 Mar 98 / 2:35 PM
- ;;5.0; INPATIENT MEDICATIONS ;**7,11,29,35,127,133,221,181**;16 DEC 97;Build 190
- ;
- ; Reference to ^PS(55 is supported by DBIA 2191
- ; Reference to ^PSDRUG( is supported by DBIA 2192
- ; Reference to ^PSSLOCK is supported by DBIA 2789
- ;
- EN ;
- I '$$HIDDEN^PSJLMUTL("SPEED") S VALMBCK="R" Q
- ;PSJ*5*221 Account for pending orders being below pending renewals
- N CODE,ST,DRG,ON,PSGONF,PSGONF2,PSGSFD,PENDCT
- D FULL^VALM1 S PSGLMT=PSJOCNT,(PSGONF,PSGONF2,PENDCT)=0
- S CODE="" F S CODE=$O(^TMP("PSJ",$J,CODE)) Q:CODE="" D
- .S ST="" F S ST=$O(^TMP("PSJ",$J,CODE,ST)) Q:ST="" D
- ..S DRG="" F S DRG=$O(^TMP("PSJ",$J,CODE,ST,DRG)) Q:DRG="" D
- ...S ON="" F S ON=$O(^TMP("PSJ",$J,CODE,ST,DRG,ON)) Q:ON="" S PSGONF=PSGONF+1 D
- ....I CODE="CC" S:$G(PSGONF2)=0 PSGONF2=PSGONF S PSGRLAST=PSGONF ;gets first renewal #
- ....;PSJ*5*221 count pending orders to offset SF selection
- ....I CODE="CB" S PENDCT=PENDCT+1
- I PENDCT,$G(PSGRLAST) S PSGRLAST=PSGRLAST-PENDCT,PSGONF2=PSGONF2-PENDCT
- I PSGONF2'>0 W !,"There are no orders which can be Speed Finished at this time.",!,"Only PENDING RENEWALS can be Speed Finished." D PAUSE^VALM1 Q
- S PSGONF=PSGONF2_"^"_PSGRLAST
- N DIR,L1,L2 S L1=+PSGONF,L2=$P(PSGONF,U,2),DIR(0)="LAO^"_L1_":"_L2,DIR("A")="FINISH which orders ("_L1_"-"_L2_"): ",DIR("?",1)="Select order"_$E("s",L1'=L2)_"to finish: ",DIR("??")="^D HELP^PSGOESF"
- D ^DIR K DIR I $D(DIRUT) K X G DONE
- I X?1N1"-" Q:$P(PSGONF,U,2)<X S Y="" F L1=+X:1 S Y=Y_L1_"," Q:L1=$P(PSGONF,U,2)
- I 'Y W $C(7),!!,"??" G EN
- ENCHK ;
- S PSJSPEED=1
- K PSGODDD S PSGODDD=1,PSGODDD(1)="" F Q=1:1:$L(Y,",") S X1=$P(Y,",",Q) D SET^PSGON Q:'$D(X)
- S PSGOSD=0 F PSGOERS=1:1:PSGODDD F PSGOERS1=1:1 S PSGOERS2=$P(PSGODDD(PSGOERS),",",PSGOERS1) Q:'PSGOERS2 S Y=+^TMP("PSJON",$J,PSGOERS2),F=$G(^PS(53.1,Y,0)),D=$G(^(.2)) D HMSG^PSGOERS I F G EN
- I $P(PSJSYSP0,"^",3) D I '$D(PSGFOK) S X="" G DONE
- .S PSGORD=^TMP("PSJON",$J,+PSGODDD(1)),PSGOFD=$P($G(^PS(53.1,+PSGORD,2)),U,4),DA=+PSGORD,DA(1)=PSGP,PSGSFD=$P($G(^PS(53.1,+PSGORD,0)),U,16)
- .S PSGORD=$P(^PS(53.1,+PSGORD,0),U,25)
- .S PSGWLL=$S($P(PSJSYSW0,"^",4):+$G(^PS(55,PSGP,5.1)),1:0),PSGOEE="R" W ! D DATE^PSGOER0(PSGP,PSGORD,PSGSFD)
- .I '$D(PSGFOK(1)) W $C(7),!,"...order",$E("s",$L(PSGODDD(1),",")>2)," NOT finished..." K PSGFOK Q
- .I 'PSGNEDFD,$P(PSJSYSW0,"^",4) D ENWALL^PSGNE3(PSGSD,PSGFD,PSGP)
- W ! F PSGOERS=1:1:PSGODDD F PSGOERS1=1:1 S PSGOERS2=$P(PSGODDD(PSGOERS),",",PSGOERS1) Q:'PSGOERS2 S PSGORD=^TMP("PSJON",$J,PSGOERS2),PSGOEFF=0 D
- .I '$$LS^PSSLOCK(PSGP,PSGORD) W !," ",PSGOERS2,". ",$P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," ",$P($G(^PS(53.1,+PSGORD,.2)),"^",2),!,"...No action taken on this order...",! H 1 Q
- .;K PSGORQF D ENDDC^PSGSICHK(PSGP,+$G(^PS(53.1,+PSGORD,1,1,0)))
- .;I '$D(PSGORQF) K PSGORQF,^TMP($J,"DI") D
- .;. F PSGDDI=1:0 S PSGDDI=$O(^PS(53.1,+PSGORD,1,PSGDDI)) Q:'PSGDDI S PSJDD=+$G(^PS(53.1,+PSGORD,1,PSGDDI,0)) D IVSOL^PSGSICHK
- .S X=$G(^PS(53.1,+PSGORD,.2)),PSGPDRGN=$$ENPDN^PSGMI(+X),PSGDO=$P(X,U,2),X=$G(^PS(53.1,+PSGORD,0)),PSGMRN=$$ENMRN^PSGMI($P(X,U,3)),PSGST=$P(X,U,7)
- .S PSGSCH=$P($G(^PS(53.1,+PSGORD,2)),U),PSGSI=$G(^(6))
- .D OC531
- .I 'PSGOEFF&($D(PSGORQF)) W !!," ",PSGOERS2,". ",$P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," ",$P($G(^PS(53.1,+PSGORD,.2)),"^",2),!,"...No action taken on this order...",! H 1 Q
- .;S X=$G(^PS(53.1,+PSGORD,.2)),PSGPDRGN=$$ENPDN^PSGMI(+X),PSGDO=$P(X,U,2),X=$G(^PS(53.1,+PSGORD,0)),PSGMRN=$$ENMRN^PSGMI($P(X,U,3)),PSGST=$P(X,U,7)
- .;S PSGSCH=$P($G(^PS(53.1,+PSGORD,2)),U),PSGSI=$G(^(6))
- .S $P(^PS(53.1,+PSGORD,2),U,2)=PSGSD,$P(^(2),U,4)=PSGFD,X=+$P($G(^PS(53.1,+PSGORD,0)),U,25)
- .I $P($G(^PS(55,PSGP,5,+X,2)),U,4)>PSGSD S $P(^(2),U,3)=$P(^(2),U,4) K DA,DIE,DR S DA(1)=PSGP,DA=X,DR="34////"_PSGSD,DIE="^PS(55,"_DA(1)_",5," D ^DIE
- .W !!," ",PSGOERS2,". ",$P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," "
- .W $P($G(^PS(53.1,+PSGORD,.2)),"^",2)
- .D UPDATE
- .D EN^PSGOEV(PSGORD)
- .D UNL^PSSLOCK(PSGP,PSGORD)
- ;
- DONE ; Kill and exit.
- S DIR(0)="E" D ^DIR K DIR
- I $G(PSGPXN) D ^PSGPER1
- K PSJSPEED,PSGODDD,PSGOERS,PSGORD,PSGOERS2,PSGPDRGN,PSGDO,PSGSCH,PSGSI,NF,Y,PSGRLAST
- Q
- HELP ; Display help text for select order to be finished prompt."
- W !!," Select the orders to be speed finished. Only orders listed under the PENDING",!,"RENEWALS heading are selectable. The start and stop date/times specified will"
- W !,"be used for all orders selected to be finished using this function.",!
- Q
- UPDATE ;
- N LOOP K ^PS(53.45,PSJSYSP,2)
- F LOOP=0:0 S LOOP=$O(^PS(53.1,+PSGORD,1,LOOP)) Q:'LOOP D
- .S ^PS(53.45,PSJSYSP,2,LOOP,0)=^PS(53.1,+PSGORD,1,LOOP,0)
- .S PSJJDRUG=$P(^PS(53.1,+PSGORD,1,LOOP,0),"^")
- .S ^PS(53.45,PSJSYSP,2,"B",PSJJDRUG,LOOP)=""
- .S ^PS(53.45,PSJSYSP,2,0)="^53.4502P"_"^"_LOOP_"^"_LOOP K PSJJDRUG
- Q
- OC531 ;* Order checks for Speed finish and regular finish
- ;PSJOCDS("ON_TYPE") - Order type of either "UD" or "IV"
- ;PSJOCDS - 0/1 (O - will exclude dose check. 1 - include the dose check for the prospective)
- N INTERVEN,PSJDDI,PSJIREQ,PSJRXREQ,PSJPDRG,PSJDD,PSJALLGY,PSJOCDS,PSJX,PSGDT,%
- D NOW^%DTC S PSGDT=%
- S Y=1,(PSJIREQ,PSJRXREQ,INTERVEN,X)=""
- ;K PSGORQF D ENDDC^PSGSICHK(PSGP,+$G(^PS(53.1,+PSGORD,1,1,0)))
- ;I '$D(PSGORQF) K PSGORQF,^TMP($J,"DI") D
- ;. F PSGDDI=1:0 S PSGDDI=$O(^PS(53.1,+PSGORD,1,PSGDDI)) Q:'PSGDDI S PSJDD=+$G(^PS(53.1,+PSGORD,1,PSGDDI,0)) K PSJPDRG D IVSOL^PSGSICHK
- I $G(PSJSPEED) D
- . F PSGDDI=0:0 S PSGDDI=$O(^PS(53.1,+PSGORD,1,PSGDDI)) Q:'PSGDDI D
- .. S PSJDD=+$G(^PS(53.1,+PSGORD,1,PSGDDI,0))
- .. S PSJX=$S('$D(^PSDRUG(+PSJDD,0)):1,$P($G(^(2)),U,3)'["U":1,$G(^("I"))="":0,1:^("I")'>$G(PSGDT))
- .. Q:PSJX
- .. S PSJALLGY(PSJDD)=""
- I '+$G(PSJSPEED) S PSJDD=$$DD53P45^PSJMISC()
- S PSJDD=$O(PSJALLGY(0)) Q:'+PSJDD
- K PSGORQF D ENDDC^PSGSICHK(PSGP,PSJDD)
- ;Only do dosing check for speed finish. Regular finish will do dosing check at ENCKDD^PSGOEF1
- I '+$G(PSJSPEED),$G(PSGOEFF) Q
- ;For some reasons PSGMR is not define when SF a UD order
- ;If user was not required to enter a DD (order was able to default a DD), need to get dosing check
- NEW PSGMR I ($G(PSGORD)["P") S PSGMR=$P($G(^PS(53.1,+PSGORD,0)),U,3)
- D:'$G(PSGORQF) IN^PSJOCDS($G(PSGORD),"UD",+PSJDD)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOESF 6291 printed Feb 18, 2025@23:28:50 Page 2
- PSGOESF ;BIR/MLM-SPEED FINISH ORDERS ENTERED THROUGH OE/RR ;10 Mar 98 / 2:35 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**7,11,29,35,127,133,221,181**;16 DEC 97;Build 190
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191
- +4 ; Reference to ^PSDRUG( is supported by DBIA 2192
- +5 ; Reference to ^PSSLOCK is supported by DBIA 2789
- +6 ;
- EN ;
- +1 IF '$$HIDDEN^PSJLMUTL("SPEED")
- SET VALMBCK="R"
- QUIT
- +2 ;PSJ*5*221 Account for pending orders being below pending renewals
- +3 NEW CODE,ST,DRG,ON,PSGONF,PSGONF2,PSGSFD,PENDCT
- +4 DO FULL^VALM1
- SET PSGLMT=PSJOCNT
- SET (PSGONF,PSGONF2,PENDCT)=0
- +5 SET CODE=""
- FOR
- SET CODE=$ORDER(^TMP("PSJ",$JOB,CODE))
- if CODE=""
- QUIT
- Begin DoDot:1
- +6 SET ST=""
- FOR
- SET ST=$ORDER(^TMP("PSJ",$JOB,CODE,ST))
- if ST=""
- QUIT
- Begin DoDot:2
- +7 SET DRG=""
- FOR
- SET DRG=$ORDER(^TMP("PSJ",$JOB,CODE,ST,DRG))
- if DRG=""
- QUIT
- Begin DoDot:3
- +8 SET ON=""
- FOR
- SET ON=$ORDER(^TMP("PSJ",$JOB,CODE,ST,DRG,ON))
- if ON=""
- QUIT
- SET PSGONF=PSGONF+1
- Begin DoDot:4
- +9 ;gets first renewal #
- IF CODE="CC"
- if $GET(PSGONF2)=0
- SET PSGONF2=PSGONF
- SET PSGRLAST=PSGONF
- +10 ;PSJ*5*221 count pending orders to offset SF selection
- +11 IF CODE="CB"
- SET PENDCT=PENDCT+1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 IF PENDCT
- IF $GET(PSGRLAST)
- SET PSGRLAST=PSGRLAST-PENDCT
- SET PSGONF2=PSGONF2-PENDCT
- +13 IF PSGONF2'>0
- WRITE !,"There are no orders which can be Speed Finished at this time.",!,"Only PENDING RENEWALS can be Speed Finished."
- DO PAUSE^VALM1
- QUIT
- +14 SET PSGONF=PSGONF2_"^"_PSGRLAST
- +15 NEW DIR,L1,L2
- SET L1=+PSGONF
- SET L2=$PIECE(PSGONF,U,2)
- SET DIR(0)="LAO^"_L1_":"_L2
- SET DIR("A")="FINISH which orders ("_L1_"-"_L2_"): "
- SET DIR("?",1)="Select order"_$EXTRACT("s",L1'=L2)_"to finish: "
- SET DIR("??")="^D HELP^PSGOESF"
- +16 DO ^DIR
- KILL DIR
- IF $DATA(DIRUT)
- KILL X
- GOTO DONE
- +17 IF X?1N1"-"
- if $PIECE(PSGONF,U,2)<X
- QUIT
- SET Y=""
- FOR L1=+X:1
- SET Y=Y_L1_","
- if L1=$PIECE(PSGONF,U,2)
- QUIT
- +18 IF 'Y
- WRITE $CHAR(7),!!,"??"
- GOTO EN
- ENCHK ;
- +1 SET PSJSPEED=1
- +2 KILL PSGODDD
- SET PSGODDD=1
- SET PSGODDD(1)=""
- FOR Q=1:1:$LENGTH(Y,",")
- SET X1=$PIECE(Y,",",Q)
- DO SET^PSGON
- if '$DATA(X)
- QUIT
- +3 SET PSGOSD=0
- FOR PSGOERS=1:1:PSGODDD
- FOR PSGOERS1=1:1
- SET PSGOERS2=$PIECE(PSGODDD(PSGOERS),",",PSGOERS1)
- if 'PSGOERS2
- QUIT
- SET Y=+^TMP("PSJON",$JOB,PSGOERS2)
- SET F=$GET(^PS(53.1,Y,0))
- SET D=$GET(^(.2))
- DO HMSG^PSGOERS
- IF F
- GOTO EN
- +4 IF $PIECE(PSJSYSP0,"^",3)
- Begin DoDot:1
- +5 SET PSGORD=^TMP("PSJON",$JOB,+PSGODDD(1))
- SET PSGOFD=$PIECE($GET(^PS(53.1,+PSGORD,2)),U,4)
- SET DA=+PSGORD
- SET DA(1)=PSGP
- SET PSGSFD=$PIECE($GET(^PS(53.1,+PSGORD,0)),U,16)
- +6 SET PSGORD=$PIECE(^PS(53.1,+PSGORD,0),U,25)
- +7 SET PSGWLL=$SELECT($PIECE(PSJSYSW0,"^",4):+$GET(^PS(55,PSGP,5.1)),1:0)
- SET PSGOEE="R"
- WRITE !
- DO DATE^PSGOER0(PSGP,PSGORD,PSGSFD)
- +8 IF '$DATA(PSGFOK(1))
- WRITE $CHAR(7),!,"...order",$EXTRACT("s",$LENGTH(PSGODDD(1),",")>2)," NOT finished..."
- KILL PSGFOK
- QUIT
- +9 IF 'PSGNEDFD
- IF $PIECE(PSJSYSW0,"^",4)
- DO ENWALL^PSGNE3(PSGSD,PSGFD,PSGP)
- End DoDot:1
- IF '$DATA(PSGFOK)
- SET X=""
- GOTO DONE
- +10 WRITE !
- FOR PSGOERS=1:1:PSGODDD
- FOR PSGOERS1=1:1
- SET PSGOERS2=$PIECE(PSGODDD(PSGOERS),",",PSGOERS1)
- if 'PSGOERS2
- QUIT
- SET PSGORD=^TMP("PSJON",$JOB,PSGOERS2)
- SET PSGOEFF=0
- Begin DoDot:1
- +11 IF '$$LS^PSSLOCK(PSGP,PSGORD)
- WRITE !," ",PSGOERS2,". ",$PIECE($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," ",$PIECE($GET(^PS(53.1,+PSGORD,.2)),"^",2),!,"...No action taken on this order...",!
- HANG 1
- QUIT
- +12 ;K PSGORQF D ENDDC^PSGSICHK(PSGP,+$G(^PS(53.1,+PSGORD,1,1,0)))
- +13 ;I '$D(PSGORQF) K PSGORQF,^TMP($J,"DI") D
- +14 ;. F PSGDDI=1:0 S PSGDDI=$O(^PS(53.1,+PSGORD,1,PSGDDI)) Q:'PSGDDI S PSJDD=+$G(^PS(53.1,+PSGORD,1,PSGDDI,0)) D IVSOL^PSGSICHK
- +15 SET X=$GET(^PS(53.1,+PSGORD,.2))
- SET PSGPDRGN=$$ENPDN^PSGMI(+X)
- SET PSGDO=$PIECE(X,U,2)
- SET X=$GET(^PS(53.1,+PSGORD,0))
- SET PSGMRN=$$ENMRN^PSGMI($PIECE(X,U,3))
- SET PSGST=$PIECE(X,U,7)
- +16 SET PSGSCH=$PIECE($GET(^PS(53.1,+PSGORD,2)),U)
- SET PSGSI=$GET(^(6))
- +17 DO OC531
- +18 IF 'PSGOEFF&($DATA(PSGORQF))
- WRITE !!," ",PSGOERS2,". ",$PIECE($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," ",$PIECE($GET(^PS(53.1,+PSGORD,.2)),"^",2),!,"...No action taken on this order...",!
- HANG 1
- QUIT
- +19 ;S X=$G(^PS(53.1,+PSGORD,.2)),PSGPDRGN=$$ENPDN^PSGMI(+X),PSGDO=$P(X,U,2),X=$G(^PS(53.1,+PSGORD,0)),PSGMRN=$$ENMRN^PSGMI($P(X,U,3)),PSGST=$P(X,U,7)
- +20 ;S PSGSCH=$P($G(^PS(53.1,+PSGORD,2)),U),PSGSI=$G(^(6))
- +21 SET $PIECE(^PS(53.1,+PSGORD,2),U,2)=PSGSD
- SET $PIECE(^(2),U,4)=PSGFD
- SET X=+$PIECE($GET(^PS(53.1,+PSGORD,0)),U,25)
- +22 IF $PIECE($GET(^PS(55,PSGP,5,+X,2)),U,4)>PSGSD
- SET $PIECE(^(2),U,3)=$PIECE(^(2),U,4)
- KILL DA,DIE,DR
- SET DA(1)=PSGP
- SET DA=X
- SET DR="34////"_PSGSD
- SET DIE="^PS(55,"_DA(1)_",5,"
- DO ^DIE
- +23 WRITE !!," ",PSGOERS2,". ",$PIECE($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," "
- +24 WRITE $PIECE($GET(^PS(53.1,+PSGORD,.2)),"^",2)
- +25 DO UPDATE
- +26 DO EN^PSGOEV(PSGORD)
- +27 DO UNL^PSSLOCK(PSGP,PSGORD)
- End DoDot:1
- +28 ;
- DONE ; Kill and exit.
- +1 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +2 IF $GET(PSGPXN)
- DO ^PSGPER1
- +3 KILL PSJSPEED,PSGODDD,PSGOERS,PSGORD,PSGOERS2,PSGPDRGN,PSGDO,PSGSCH,PSGSI,NF,Y,PSGRLAST
- +4 QUIT
- HELP ; Display help text for select order to be finished prompt."
- +1 WRITE !!," Select the orders to be speed finished. Only orders listed under the PENDING",!,"RENEWALS heading are selectable. The start and stop date/times specified will"
- +2 WRITE !,"be used for all orders selected to be finished using this function.",!
- +3 QUIT
- UPDATE ;
- +1 NEW LOOP
- KILL ^PS(53.45,PSJSYSP,2)
- +2 FOR LOOP=0:0
- SET LOOP=$ORDER(^PS(53.1,+PSGORD,1,LOOP))
- if 'LOOP
- QUIT
- Begin DoDot:1
- +3 SET ^PS(53.45,PSJSYSP,2,LOOP,0)=^PS(53.1,+PSGORD,1,LOOP,0)
- +4 SET PSJJDRUG=$PIECE(^PS(53.1,+PSGORD,1,LOOP,0),"^")
- +5 SET ^PS(53.45,PSJSYSP,2,"B",PSJJDRUG,LOOP)=""
- +6 SET ^PS(53.45,PSJSYSP,2,0)="^53.4502P"_"^"_LOOP_"^"_LOOP
- KILL PSJJDRUG
- End DoDot:1
- +7 QUIT
- OC531 ;* Order checks for Speed finish and regular finish
- +1 ;PSJOCDS("ON_TYPE") - Order type of either "UD" or "IV"
- +2 ;PSJOCDS - 0/1 (O - will exclude dose check. 1 - include the dose check for the prospective)
- +3 NEW INTERVEN,PSJDDI,PSJIREQ,PSJRXREQ,PSJPDRG,PSJDD,PSJALLGY,PSJOCDS,PSJX,PSGDT,%
- +4 DO NOW^%DTC
- SET PSGDT=%
- +5 SET Y=1
- SET (PSJIREQ,PSJRXREQ,INTERVEN,X)=""
- +6 ;K PSGORQF D ENDDC^PSGSICHK(PSGP,+$G(^PS(53.1,+PSGORD,1,1,0)))
- +7 ;I '$D(PSGORQF) K PSGORQF,^TMP($J,"DI") D
- +8 ;. F PSGDDI=1:0 S PSGDDI=$O(^PS(53.1,+PSGORD,1,PSGDDI)) Q:'PSGDDI S PSJDD=+$G(^PS(53.1,+PSGORD,1,PSGDDI,0)) K PSJPDRG D IVSOL^PSGSICHK
- +9 IF $GET(PSJSPEED)
- Begin DoDot:1
- +10 FOR PSGDDI=0:0
- SET PSGDDI=$ORDER(^PS(53.1,+PSGORD,1,PSGDDI))
- if 'PSGDDI
- QUIT
- Begin DoDot:2
- +11 SET PSJDD=+$GET(^PS(53.1,+PSGORD,1,PSGDDI,0))
- +12 SET PSJX=$SELECT('$DATA(^PSDRUG(+PSJDD,0)):1,$PIECE($GET(^(2)),U,3)'["U":1,$GET(^("I"))="":0,1:^("I")'>$GET(PSGDT))
- +13 if PSJX
- QUIT
- +14 SET PSJALLGY(PSJDD)=""
- End DoDot:2
- End DoDot:1
- +15 IF '+$GET(PSJSPEED)
- SET PSJDD=$$DD53P45^PSJMISC()
- +16 SET PSJDD=$ORDER(PSJALLGY(0))
- if '+PSJDD
- QUIT
- +17 KILL PSGORQF
- DO ENDDC^PSGSICHK(PSGP,PSJDD)
- +18 ;Only do dosing check for speed finish. Regular finish will do dosing check at ENCKDD^PSGOEF1
- +19 IF '+$GET(PSJSPEED)
- IF $GET(PSGOEFF)
- QUIT
- +20 ;For some reasons PSGMR is not define when SF a UD order
- +21 ;If user was not required to enter a DD (order was able to default a DD), need to get dosing check
- +22 NEW PSGMR
- IF ($GET(PSGORD)["P")
- SET PSGMR=$PIECE($GET(^PS(53.1,+PSGORD,0)),U,3)
- +23 if '$GET(PSGORQF)
- DO IN^PSJOCDS($GET(PSGORD),"UD",+PSJDD)
- +24 QUIT