PSGOESF ;BIR/MLM-SPEED FINISH ORDERS ENTERED THROUGH OE/RR ; 4/27/09 2:39pm
;;5.0; INPATIENT MEDICATIONS ;**7,11,29,35,127,133,221**;16 DEC 97;Build 11
;
; Reference to ^PS(55 is supported by DBIA 2191
; Reference to ^TMP is supported by DBIA 2190
; 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
.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
N INTERVEN,PSJDDI,PSJIREQ,PSJRXREQ,PSJPDRG
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
Q
PSGOESF ;BIR/MLM-SPEED FINISH ORDERS ENTERED THROUGH OE/RR ; 4/27/09 2:39pm
+1 ;;5.0; INPATIENT MEDICATIONS ;**7,11,29,35,127,133,221**;16 DEC 97;Build 11
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191
+4 ; Reference to ^TMP is supported by DBIA 2190
+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 DO OC531
+16 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
+17 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)
+18 SET PSGSCH=$PIECE($GET(^PS(53.1,+PSGORD,2)),U)
SET PSGSI=$GET(^(6))
+19 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)
+20 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
+21 WRITE !," ",PSGOERS2,". ",$PIECE($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," "
+22 WRITE $PIECE($GET(^PS(53.1,+PSGORD,.2)),"^",2)
+23 DO UPDATE
+24 DO EN^PSGOEV(PSGORD)
+25 DO UNL^PSSLOCK(PSGP,PSGORD)
End DoDot:1
+26 ;
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 NEW INTERVEN,PSJDDI,PSJIREQ,PSJRXREQ,PSJPDRG
+2 SET Y=1
SET (PSJIREQ,PSJRXREQ,INTERVEN,X)=""
+3 KILL PSGORQF
DO ENDDC^PSGSICHK(PSGP,+$GET(^PS(53.1,+PSGORD,1,1,0)))
+4 IF '$DATA(PSGORQF)
KILL PSGORQF,^TMP($JOB,"DI")
Begin DoDot:1
+5 FOR PSGDDI=1:0
SET PSGDDI=$ORDER(^PS(53.1,+PSGORD,1,PSGDDI))
IF 'PSGDDI
QUIT
SET PSJDD=+$GET(^PS(53.1,+PSGORD,1,PSGDDI,0))
KILL PSJPDRG
DO IVSOL^PSGSICHK
End DoDot:1
+6 QUIT
