PSODISP3 ;ISC-BHAM/SAB rx speed release ;08/30/95 10:24
 ;;7.0;OUTPATIENT PHARMACY;**15,13,148**;DEC 1997
 ;External reference ^PS(59.7 supported by DBIA 694
 ;External reference ^XTMP("PSA" supported by DBIA 1036
 ;External reference $$SERV^IBARX supported by DBIA 2245
SEL N VALMCNT I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
 K ^UTILITY($J,"PSOPCE"),QFLG,PSOFDR,DIR,DUOUT,DIRUT S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
 K DIR,DIRUT,DTOUT,PSOOELSE,DTOUT I +Y S (SPEED,PSOOELSE,PSOPCECT)=1 D FULL^VALM1 S LST=Y D
 . D ASK Q:$G(QFLG)  S PSOLIST=0,PSOPID=1
 . F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']""  D
 . . K ISUF,IFN S ORN=$P(LST,",",ORD)
 . . S RXP=$P(PSOLST($P(LST,",",ORD)),"^",2),POERR=1
 . . D:+PSOLST(ORN)=52 FULL^VALM1,BC1^PSODISP W ! S PSOLIST=PSOLIST+1
 . . I PSOLIST=5 D
 . . . K DIR,DIRUT S DIR(0)="E",DIR("A",1)="",DIR("A")="Press Return to Continue"
 . . . W ! D ^DIR K DIR,DIRUT S PSOLIST=0
 . I $D(DISGROUP),$D(BINGNAM),($D(BINGDIV)!$D(BNGPDV)!$D(BNGRDV)),($D(BINGRO)!$D(BINGRPR)) N TM,TM1 D REL^PSOBING1 K BINGNAM,BINGDIV,BINGRO,BINGRPR,BNGPDV,BNGRDV D
 . . K DIR,DIRUT S DIR(0)="E",DIR("A",1)="",DIR("A")="Press Return to Continue"
 . . W ! D ^DIR K DIR,DIRUT
 I '$G(PSOOELSE) S VALMBCK="" Q
 S VALMBCK="R",PSORXED=1 D BLD^PSOORUT1
 ;D PCE^PSODISP
EX K SPEED,PSOPCECT,PSOOELSE,QFLG,PSORXED,OUT,RX2,RXFD,RESK,ISUF,SUPN,%,DIC,IFN,J,DA,DR,DIE,X,X1,X2,Y,RXP,CX,PX,ORD,LST,POERR,PSOLIST
 K REC,DIR,YDT,REC,RDUZ,DIRUT,PSOCPN,PSOCPRX,PSOIBSS,PSOIBFL,PSOIBLP,PSOIBST,YY,QDRUG,QTY,TYPE,XTYPE,DUOUT,PSRH,XX,Y,PSIN
 Q
ASK ;
 I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) S VALMSG="Site Parameters must be defined to use the Release option!",VALMBCK="R",QFLG=1 Q
 S VALMBCK="Q",Y=$G(^PS(59,PSOSITE,"IB")),PSOIBSS=$$SERV^IBARX1(+Y) I 'PSOIBSS D IBSSR^PSOUTL I 'PSOIBFL D  S VALMBCK="R",QFLG=1 Q
 .W $C(7),!!,"The IB SERVICE/SECTION defined in your site parameter file is not valid.",!,"You will not be able to release any medication until this is corrected!",! H 3
 W !! S PSIN=+$P($G(^PS(59.7,1,49.99)),"^",2)
RPH S DIC("S")="I $D(^XUSEC(""PSORPH"",+Y))",DIC("A")="Enter PHARMACIST: ",DIC="^VA(200,",DIC(0)="QEAM" D ^DIC I "^"[X S QFLG=1 Q
 G:Y=-1 RPH K DIC I $D(DIRUT) S QFLG=1 Q
 S PSRH=+Y
 ;check for Drug Acct background job K8 & K7.1
 S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19.2 D ^DIC I Y=-1 K DIC,X,Y Q
 I $P($G(Y(0)),U,2)>DT S PSODA=1 S:'$P($G(^XTMP("PSA",0)),U,2) $P(^(0),U,2)=DT Q
 S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19 D ^DIC K DIC,X Q:Y=-1
 K DIQ,PSA S DA=+Y,DIC=19,DIQ="PSA",DR=200,DIQ(0)="IN" D EN^DIQ1
 I '$D(PSA(19,DA,200,"I")) K DIC,DA,X,Y,DIQ Q
 I PSA(19,DA,200,"I")>DT S PSODA=1 S:'$P($G(^XTMP("PSA",0)),U,2) $P(^(0),U,2)=DT
 K PSA,DIC,DA,X,Y,DIQ
 Q