| [613] | 1 | PSODISP3 ;ISC-BHAM/SAB rx speed release ;08/30/95 10:24
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**15,13,148**;DEC 1997
|
|---|
| 3 | ;External reference ^PS(59.7 supported by DBIA 694
|
|---|
| 4 | ;External reference ^XTMP("PSA" supported by DBIA 1036
|
|---|
| 5 | ;External reference $$SERV^IBARX supported by DBIA 2245
|
|---|
| 6 | SEL N VALMCNT I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
|
|---|
| 7 | 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
|
|---|
| 8 | K DIR,DIRUT,DTOUT,PSOOELSE,DTOUT I +Y S (SPEED,PSOOELSE,PSOPCECT)=1 D FULL^VALM1 S LST=Y D
|
|---|
| 9 | . D ASK Q:$G(QFLG) S PSOLIST=0,PSOPID=1
|
|---|
| 10 | . F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" D
|
|---|
| 11 | . . K ISUF,IFN S ORN=$P(LST,",",ORD)
|
|---|
| 12 | . . S RXP=$P(PSOLST($P(LST,",",ORD)),"^",2),POERR=1
|
|---|
| 13 | . . D:+PSOLST(ORN)=52 FULL^VALM1,BC1^PSODISP W ! S PSOLIST=PSOLIST+1
|
|---|
| 14 | . . I PSOLIST=5 D
|
|---|
| 15 | . . . K DIR,DIRUT S DIR(0)="E",DIR("A",1)="",DIR("A")="Press Return to Continue"
|
|---|
| 16 | . . . W ! D ^DIR K DIR,DIRUT S PSOLIST=0
|
|---|
| 17 | . 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
|
|---|
| 18 | . . K DIR,DIRUT S DIR(0)="E",DIR("A",1)="",DIR("A")="Press Return to Continue"
|
|---|
| 19 | . . W ! D ^DIR K DIR,DIRUT
|
|---|
| 20 | I '$G(PSOOELSE) S VALMBCK="" Q
|
|---|
| 21 | S VALMBCK="R",PSORXED=1 D BLD^PSOORUT1
|
|---|
| 22 | ;D PCE^PSODISP
|
|---|
| 23 | 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
|
|---|
| 24 | K REC,DIR,YDT,REC,RDUZ,DIRUT,PSOCPN,PSOCPRX,PSOIBSS,PSOIBFL,PSOIBLP,PSOIBST,YY,QDRUG,QTY,TYPE,XTYPE,DUOUT,PSRH,XX,Y,PSIN
|
|---|
| 25 | Q
|
|---|
| 26 | ASK ;
|
|---|
| 27 | 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
|
|---|
| 28 | 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
|
|---|
| 29 | .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
|
|---|
| 30 | W !! S PSIN=+$P($G(^PS(59.7,1,49.99)),"^",2)
|
|---|
| 31 | 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
|
|---|
| 32 | G:Y=-1 RPH K DIC I $D(DIRUT) S QFLG=1 Q
|
|---|
| 33 | S PSRH=+Y
|
|---|
| 34 | ;check for Drug Acct background job K8 & K7.1
|
|---|
| 35 | S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19.2 D ^DIC I Y=-1 K DIC,X,Y Q
|
|---|
| 36 | 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
|
|---|
| 37 | S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19 D ^DIC K DIC,X Q:Y=-1
|
|---|
| 38 | K DIQ,PSA S DA=+Y,DIC=19,DIQ="PSA",DR=200,DIQ(0)="IN" D EN^DIQ1
|
|---|
| 39 | I '$D(PSA(19,DA,200,"I")) K DIC,DA,X,Y,DIQ Q
|
|---|
| 40 | I PSA(19,DA,200,"I")>DT S PSODA=1 S:'$P($G(^XTMP("PSA",0)),U,2) $P(^(0),U,2)=DT
|
|---|
| 41 | K PSA,DIC,DA,X,Y,DIQ
|
|---|
| 42 | Q
|
|---|
