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 Apr 09, 2024@21:08:21 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
