| 1 | PSAPSI5 ;BIR/LTL,JMB-Nightly Background Job - CONT'D ;7/23/97
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**14,25**; 10/24/97
|
|---|
| 3 | ;This routine gathers IV and unit dose dispensing data.
|
|---|
| 4 | ;
|
|---|
| 5 | ;References to ^PS(50.8 are covered by IA 771 (#771)
|
|---|
| 6 | ;Reference to ^PS(57.6 are covered by IA #772
|
|---|
| 7 | ;
|
|---|
| 8 | SOL S PSAW=PSADT(3),PSADRUG(3)=$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,"AC",52.7,+PSADRUG(2),0))
|
|---|
| 9 | F S PSAW=$O(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW)) Q:'PSAW S PSAW(1)=PSAW D:$O(^PSD(58.8,"AB",PSAW,0))=PSALOC
|
|---|
| 10 | .S PSAQ=$G(PSAQ)+$P($G(^PS(50.8,+PSAIV,2,+PSADT(4),2,+PSADRUG(3),3,PSAW,0)),"^",2)-$P($G(^(0)),"^",5)
|
|---|
| 11 | S:PSAQ ^TMP("PSA",$J,+PSADRUG,PSADT(4))=$G(^TMP("PSA",$J,+PSADRUG,PSADT(4)))+PSAQ S (PSAQ,PSAW)=0
|
|---|
| 12 | Q
|
|---|
| 13 | EN ; Entry point Unit Dose dispensing, returns, extras, & pre-exchange
|
|---|
| 14 | Q ;DAVE B (PSA*3*25)
|
|---|
| 15 | S X1=DT,X2=1 D C^%DTC S ^XTMP("PSAPL",0)=X
|
|---|
| 16 | G:$G(PSGRTN)="PSGPLF" PICKLST
|
|---|
| 17 | ;
|
|---|
| 18 | ;Call must have came from PSGAMSA then, instead of PSGPLF
|
|---|
| 19 | I $D(PSGY) S PSAQTY=PSGY
|
|---|
| 20 | ;drug stocked in Drug Acct Location?
|
|---|
| 21 | G:'+PSGDRG!('$D(^PSD(58.8,"C",+PSGDRG))) EXIT
|
|---|
| 22 | G:'$D(PSGWARD) EXIT
|
|---|
| 23 | ;DAVE B (PSA*3*14) Check for more than one pharmacy location
|
|---|
| 24 | ;associated with the Ward
|
|---|
| 25 | S PSALOC1=""
|
|---|
| 26 | 1 S PSALOC1=$O(^PSD(58.8,"AB",PSGWARD,PSALOC1)) I PSALOC1="" G EXIT
|
|---|
| 27 | I 'PSALOC1!('$D(^PSD(58.8,"ADISP","P",+PSALOC1)))!('+$P($G(^PSD(58.8,+PSALOC1,0)),"^",3)) G 1
|
|---|
| 28 | I +$G(^PSD(58.8,+PSALOC1,"I")),+^PSD(58.8,+PSALOC1,"I")'>DT G 1
|
|---|
| 29 | S PSAIPST=+$P($G(^PSD(58.8,PSALOC1,0)),"^",3)
|
|---|
| 30 | D NOW^%DTC
|
|---|
| 31 | S ^XTMP("PSAPL",+PSAIPST,+PSGDRG,+$S($D(PSGPLFDT):PSGPLFDT,1:$P(%,".")))=$G(^XTMP("PSAPL",+PSAIPST,+PSGDRG,+$S($D(PSGPLFDT):PSGPLFDT,1:$P(%,"."))))+$G(PSAQTY)
|
|---|
| 32 | EXIT K PSGBK,PSADA,PSGRTN,PSALOC1,PSAQTY
|
|---|
| 33 | Q
|
|---|
| 34 | PICKLST ;Pick List dispensing and returns.
|
|---|
| 35 | I '+D3!('$D(^PSD(58.8,"C",D3))) G EXIT
|
|---|
| 36 | S PSAQTY=$P($G(^PS(57.6,D0,1,D1,1,D2,1,D3,0)),"^",2)
|
|---|
| 37 | S PSALOC1=""
|
|---|
| 38 | 2 S PSALOC1=$O(^PSD(58.8,"AB",D1,PSALOC1)) I PSALOC1="" G EXIT
|
|---|
| 39 | I 'PSALOC1!('$D(^PSD(58.8,"ADISP","P",+PSALOC1)))!('+$P($G(^PSD(58.8,+PSALOC1,0)),"^",3)) G 2
|
|---|
| 40 | I +$G(^PSD(58.8,+PSALOC1,"I")) G 2
|
|---|
| 41 | S PSAIPST=+$P($G(^PSD(58.8,PSALOC1,0)),"^",3)
|
|---|
| 42 | S ^XTMP("PSAPL",+PSAIPST,+D3,+D0)=$G(^XTMP("PSAPL",+PSAIPST,+D3,+D0))+$G(PSAQTY)
|
|---|
| 43 | Q
|
|---|
