43 lines
2.7 KiB
Mathematica
43 lines
2.7 KiB
Mathematica
|
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
|