PSGOERS ;BIR/CML3-RENEW SELECTED ORDERS ;05 DEC 97 / 8:42 AM
 ;;5.0; INPATIENT MEDICATIONS ;**11,29,35,47,58,110**;16 DEC 97
 ;
 ; Reference to ^PS(50.7 is supported by DBIA 2180
 ; 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
 ; Reference to NOW^%DTC is supported by DBIA 10000
 ;
MARK ; only mark order, not actually renew
 W !,"...marking ",PSGPDRGN," ",PSGDO,"..." S $P(^PS(55,PSGP,5,+PSGORD,4),"^",15,17)="1^"_DUZ_"^"_PSGDT,PSGAL("C")=13180 D ^PSGAL5 W "."
 I $D(PSJSYSO) S PSGPOSA="R",PSGPOSD=PSGDT,PSGORD=+PSGORD_"A" D ENPOS^PSGVDS
 Q
RENEW ; mark or renew order
 D NOW^%DTC K DA S DA(1)=PSGP,DA=+PSGORD,PSGDT=+$E(%,1,12)
 ; do order checking
 N PSJABT,PSGDRG ;* S PSGDRG=$P($G(^PS(55,PSGP,5,+PSGORD,1,1,0)),"^")
 ;* K PSGORQF D ENDDC^PSGSICHK(PSGP,+PSGDRG)
 D OC55^PSGOER
 I $D(PSGORQF) W !!,"  ",PSGOERS2,". ",$P($$DRUGNAME^PSJLMUTL(PSGP,PSGORD),"^")," ",$P(^PS(55,PSGP,5,+PSGORD,.2),"^",2),!,"...No action taken on this order...",! Q
 ;* Q:$D(PSGORQF)  ; quit if not to continue
 ;
 S PSGOER1=$G(^PS(55,PSGP,5,+PSGORD,.2)),PSGDO=$P(PSGOER1,"^",2),PSGPDRG=$P(PSGOER1,"^"),PSGPDRGN=$$ENPDN^PSGMI(PSGPDRG) I '$P(PSJSYSP0,"^",3) G MARK
 S PSGOER0=$G(^PS(55,PSGP,5,+PSGORD,0)),PSGST=$P(PSGOER0,"^",7),PSGOER2=$G(^(2)),PSGND4=$G(^(4)),PSGSI=$G(^(6)),PSGOSD=$P(PSGOER2,"^",2),PSGOFD=$P(PSGOER2,"^",4),PSGNEDFD=$P($$GTNEDFD^PSGOE7("U",PSGPDRG),U)_"^^"_PSGST
 N PSGOEAV S PSGOEAV=1,PSGOORD=PSGORD W "." K ^PS(53.45,PSJSYSP,1),^(2)
 I $$CHKDD() W !!,"...",PSGPDRGN," ",PSGDO," order NOT renewed..." Q
 W !!,"...renewing ",PSGOERS2,". ",PSGPDRGN," ",PSGDO,"..."
 S PSGMR=$P(PSGOER0,"^",3),PSGMRN=$$ENMRN^PSGMI(PSGMR),PSGSM=$P(PSGOER0,"^",5),PSGHSM=$P(PSGOER0,"^",6),PSGPDRG=$P(PSGOER1,"^"),PSGDO=$P(PSGOER1,"^",2)
 S PSGSCH=$P(PSGOER2,"^"),PSGS0Y=$P(PSGOER2,"^",5),PSGS0XT=$P(PSGOER2,"^",6),PSGNESD=PSGSD,PSGNEFD=$S(PSGST="O":PSGSD,1:PSGFD)
 S:PSJPWD'=$P(PSGOER2,U,10) PSGS0Y=$$ENRNAT^PSGOU($P(PSGOER2,U,10),+PSJPWD,PSGSCH,PSGS0Y)
 ;K ^PS(53.45,PSJSYSP,4) S Q=0 F  S Q=$O(^PS(55,PSGP,5,+PSGORD,12,Q)) Q:'Q  S ^PS(53.45,PSJSYSP,4,Q,0)=$G(^(Q,0))
 I $O(^PS(55,PSGP,5,+PSGORD,3,0)) S ^PS(53.45,PSJSYSP,1,0)=^(0),Q=0 F  S Q=$O(^PS(55,PSGP,5,+PSGORD,3,Q)) Q:'Q  S ^PS(53.45,PSJSYSP,1,Q,0)=$G(^(Q,0))
 I '$O(^PS(53.45,PSJSYSP,2,0)) D
 .S X=$O(^PS(55,PSGP,5,+PSGORD,1,0)) I X S (Q,Q1)=0 F  S Q=$O(^PS(55,PSGP,5,+PSGORD,1,Q)) Q:'Q  S ND=$G(^(Q,0)) I ND,$S('$P(ND,"^",3):1,1:$P(ND,"^",3)>DT) S Q1=Q1+1,^PS(53.45,PSJSYSP,2,Q1,0)=$P(ND,"^",1,3)
 D SPEED^PSGOER
 ; PSGP,PSGORD) D UPDREN(PSGORD,PSGDT,PSGOEPR,PSGOFD,PSJNOO),UPDRENOE(PSGP,PSGORD,PSGDT
 ;S:$S(X:Q1,1:0) ^PS(53.45,PSJSYSP,2,0)="^53.4502P^"_Q1_"^"_Q1 D ^PSGOETO I +PSJSYSU=3,PSGOORD["O" D EN^PSGPEN(+PSGORD)
 ;W !,"...updating original order...",! K DA S DA(1)=PSGP,DA=+PSGOORD,PSGAL("C")=PSJSYSU*10+18000 D ^PSGAL5
 ;I PSGORD'["O",PSGSD<PSGOFD S PSGALR=70,DIE="^PS(55,"_PSGP_",5,",DR="34////"_+PSGSD S:PSGSD'>PSGDT DR=DR_";28////E"
 ;I  D ^DIE I $P($G(^PS(55,PSGP,5,+PSGOORD,0)),"^",21) D EN1^PSJHL2(PSGP,"SC",PSGOORD,"ORDER EXPIRED")
 ;S $P(PSGND4,"^",12,14)="^^",$P(PSGND4,"^",15,20)="^^^^^",$P(PSGND4,"^",22,24)="^^",^PS(55,PSGP,5,+PSGOORD,4)=PSGND4,$P(^(0),"^",26,27)=PSGORD_"^R"
 Q
CHKDD() ;
 I '$$CHKDD^PSGOE2("^PS(55,"_PSGP_",5,"_+PSGORD_",") Q 0
 I $P(PSJSYSU,";")'=3,'$P(PSJSYSP0,U,2) W !!,"This order's dispense drug is invalid, a pharmacist must renew this order." Q 1
 W !!,"THE DISPENSE DRUG IS MISSING FROM THIS ORDER."
 D ENDRG^PSGOEF1(+^PS(55,PSGP,5,+PSGORD,.2),0)
 I $G(DUOUT) W !,"ORDER NOT RENEW."
 Q $G(DUOUT)!'$G(DRG)
EN ;
 Q:'$$HIDDEN^PSJLMUTL("SPEED")  S PSJSPEED=1
 N PSGONR,CODE,ST,DRG,ON S PSGOEORF=1 D FULL^VALM1
 S CODE="",PSGONR=0 F  S CODE=$O(^TMP("PSJ",$J,CODE)) Q:CODE'="A"  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=""  S ON="" F  S ON=$O(^TMP("PSJ",$J,CODE,ST,DRG,ON)) Q:ON=""  S PSGONR=PSGONR+1
 S PSGONW="R",PSGLMT=PSGONR D ENWO^PSGON I "^"[X K X G DONE
 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(55,PSGP,5,Y,0)),D=$G(^(.2)) D HMSG I F G EN
 I $P(PSJSYSP0,"^",3) D  I '$D(PSGFOK) S X="" G DONE
 .NEW PSGRENEW S PSGRENEW=1
 .S PSGORD=^TMP("PSJON",$J,+PSGODDD(1)),DA=+PSGORD,DA(1)=PSGP,PSGWLL=$S($P(PSJSYSW0,"^",4):+$G(^PS(55,PSGP,5.1)),1:0),PSGOEE="R" W ! D DATE^PSGOER0(PSGP,PSGORD,PSGDT)
 .I '$D(PSGFOK(106)) W $C(7),!,"...order",$E("s",$L(PSGODDD(1),",")>2)," NOT renewed..." K PSGFOK Q
 .I 'PSGNEDFD,$P(PSJSYSW0,"^",4),PSGFD'<PSGWLL S $P(^PS(55,PSGP,5.1),"^")=+PSGFD
 ;W ! F PSGOERS=1:1:PSGODDD F PSGOERS1=1:1 S PSGOERS2=$P(PSGODDD(PSGOERS),",",PSGOERS1) Q:'PSGOERS2  S PSGORD=^TMP("PSJON",$J,PSGOERS2) D RENEW
 W !
 S EXITLOOP=0
 F PSGOERS=1:1:PSGODDD D
 .F PSGOERS1=1:1 D  Q:EXITLOOP=1
 ..S PSGOERS2=$P(PSGODDD(PSGOERS),",",PSGOERS1)
 ..I 'PSGOERS2 S EXITLOOP=1 Q
 ..S PSGORD=^TMP("PSJON",$J,PSGOERS2)
 ..I $$CHKCOM Q
 ..I '$$LS^PSSLOCK(DFN,PSGORD) W !,$P($$DRUGNAME^PSJLMUTL(DFN,PSGORD),"^",1),!,"NO ACTION WAS TAKEN",!,$C(7) HANG 1 Q
 ..D RENEW
 ..; Call the unlock procedure
 ..D UNL^PSSLOCK(DFN,PSGORD)
 ..I $G(PSGOORD) D UNL^PSSLOCK(DFN,PSGOORD)
 S X=""
DONE ;
 D INIT^PSJLMHED(1)
 K DA,DIE,DR,FDSD,PSGAL,PSGALR,PSGFD,PSGFOK,PSGLMT,PSGND4,PSGODDD,PSGOERS,PSGOERS1,PSGOERS2,PSGONW,PSGOPR,PSGORD,PSGOSD,PSGPOSA,PSGPOSD,PSGPR,PSGPX,PSGSD,PSGST,PSGTOL,PSGTOO,PSGUOW,PSGWLL,PSJSPEED
 Q
GRI ; get renewal info
HMSG ; hold/'not to be given' message
 S X=$P($G(^PS(50.7,+D,0)),"^") S:X]"" X=X_" "_$P(D,"^",2)
 I $P(F,"^",22) S H="has been marked as 'NOT TO BE GIVEN'" D WO Q
 I $P(F,"^",9)="H" S H="is ON HOLD" D WO Q
 I $P(F,"^",27)]"",$P(F,"^",26) S H="has been "_$S($P(F,"^",24)="E":"EDITED",1:"RENEWED") D WO Q
 I ($P($G(^PS(50.7,+D,0)),"^",4)]"")&($P($G(^(0)),"^",4)'>DT) S H="is no longer an active Orderable Item" D WO Q
 N PSGDFLG,DRG,DRGPT
 S PSGDFLG=1 F DRG=0:0 S DRG=$O(^PSDRUG("ASP",+D,DRG)) Q:'DRG  I $P(^PSDRUG(DRG,2),U,3)["U",($G(^PSDRUG(DRG,"I"))=""!($G(^("I"))>DT)) S PSGDFLG=0 Q
 I PSGDFLG S H="is no longer an active Dispense drug" D WO Q
 S F=0,X=$P($G(^PS(55,PSGP,5,Y,2)),"^",2) S:X>PSGOSD PSGOSD=X Q
WO ;
 W $C(7),"  ??",! W:X]"" !,X S H1="Order number "_$G(PSGOERS2)_" "_H_", and cannot be renewed." W ! F H2=1:1:$L(H1," ") S H3=$P(H1," ",H2) W:$L(H3)+$X>78 ! W H3," "
 S F=1 K H,H1,H2,H3 Q
CHKCOM() ;       Check if this order is a complex order
 S PSJCOM=0
 I PSGORD=+PSGORD S PSJCOM=PSGORD W !,"  Order ",PSGOERS2," is part of a complex order series, and cannot be renewed.",! H 2 Q PSJCOM
 S PSJCOM=$S(PSGORD["U":$P($G(^PS(55,PSGP,5,+PSGORD,.2)),U,8),1:$P($G(^PS(53.1,+PSGORD,.2)),U,8))
 I PSJCOM  W !,"  Order ",PSGOERS2," is part of a complex order series, and cannot be renewed.",! H 2
 Q PSJCOM