| 1 | PSDRFT ;B'ham ISC/JPW,LTL - File Delayed Dispensing Info ; 13 Dec 93
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;**66**;13 Feb 97;Build 3
|
|---|
| 3 | UPDAT I $G(PSDPN) F JJ=0:0 S JJ=$O(^PSD(58.8,"F",PSDPN,NAOU,PSDR,JJ)) Q:'JJ S ORD=+JJ
|
|---|
| 4 | ;$S(WQTY:18,CQTY:9,1:17) S:PSDTYP=9 QTY=CQTY-OQTY
|
|---|
| 5 | W ?40,"Recording transaction... "
|
|---|
| 6 | D UPDATE W "done."
|
|---|
| 7 | END ;kill variables
|
|---|
| 8 | K %,%DT,%H,%I,BAL,CQTY,DA,DIC,DIE,DIK,DINUM,DLAYGO,DR,JJ,LQTY,NAOUN,NODE,NUR2,OK,ORD
|
|---|
| 9 | K PSD,PSDER,PSDREC,PSDRN,PSDT,PSDTN,QTY,WQTY,X,Y
|
|---|
| 10 | Q
|
|---|
| 11 | UPDATE ;update 58.8 and 58.81
|
|---|
| 12 | ;updating drug balance in 58.8
|
|---|
| 13 | F L +^PSD(58.8,NAOU,1,PSDR,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 14 | D NOW^%DTC S PSDTN=+%
|
|---|
| 15 | S BAL=$P(^PSD(58.8,NAOU,1,PSDR,0),"^",4),$P(^(0),"^",4)=$P(^(0),"^",4)-PSDQ
|
|---|
| 16 | L -^PSD(58.8,NAOU,1,PSDR,0)
|
|---|
| 17 | ;update order balance
|
|---|
| 18 | I $G(ORD),$D(^PSD(58.8,NAOU,1,PSDR,3,ORD,0)),PSDTYP'=9 S $P(^(0),"^",22)=$P(^(0),"^",22)-PSDQ,DA=+$P(^(0),"^",17) D:$P(^(0),"^",22)=0 K DA,DIE,DR
|
|---|
| 19 | .K DIE,DR S DIE="^PSD(58.81,",DR="10////12;11////1" D ^DIE K DA,DIE,DR
|
|---|
| 20 | .K DA,DIE,DR S DIE="^PSD(58.8,"_NAOU_",1,"_PSDR_",3,",DA=+ORD,DA(1)=+PSDR,DA(2)=+NAOU,DR="10////12;11////1" D ^DIE K DA,DIE,DR
|
|---|
| 21 | ADD ;find entry number in 58.81
|
|---|
| 22 | F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 23 | FIND S PSDREC=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSDREC)) S $P(^PSD(58.81,0),"^",3)=PSDREC G FIND
|
|---|
| 24 | K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.81,(X,DINUM)=PSDREC D ^DIC K DIC,DLAYGO
|
|---|
| 25 | L -^PSD(58.81,0)
|
|---|
| 26 | EDIT ;edit new transaction in 58.81
|
|---|
| 27 | S ^PSD(58.81,PSDREC,0)=PSDREC_"^"_PSDTYP_"^"_NAOU_"^"_PSDT_"^"_PSDR_"^"_$S(PSDTYP=9:-PSDQ,1:PSDQ)_"^"_$G(NUR1(1))_"^^^"_BAL_"^^^^^^Dose signed out during computer down time^"_$G(PSDPN)_"^"_NAOU_"^^"_$G(ORD)
|
|---|
| 28 | S ^PSD(58.81,PSDREC,9)=$G(PAT)_"^"_NUR1_"^"_OQTY_"^"_$G(WQTY)_"^"_$G(LQTY)_"^"_$G(NUR2)_"^"_BAL
|
|---|
| 29 | ;S:PATL ^PSD(58.81,PSDREC,9.5)=PATL
|
|---|
| 30 | S ^PSD(58.81,PSDREC,"CS")=1
|
|---|
| 31 | K DA,DIK S DA=PSDREC,DIK="^PSD(58.81," D IX^DIK K DA,DIK
|
|---|
| 32 | I PSDTYP'=17 D ERR
|
|---|
| 33 | Q
|
|---|
| 34 | ERR ;err log update
|
|---|
| 35 | F L +^PSD(58.89,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 36 | FIND9 S PSDER=$P(^PSD(58.89,0),"^",3)+1 I $D(^PSD(58.89,PSDER)) S $P(^PSD(58.89,0),"^",3)=PSDER G FIND9
|
|---|
| 37 | K DIC,DLAYGO S DIC(0)="L",(DIC,DLAYGO)=58.89,(X,DINUM)=PSDER D ^DIC K DIC,DLAYGO
|
|---|
| 38 | L -^PSD(58.89,0)
|
|---|
| 39 | EDIT9 ;edit error log
|
|---|
| 40 | K DA,DIE,DR S DA=PSDER,DIE=58.89,DR="1////"_PSDREC_";2////"_PSDT_";6////"_NAOU D ^DIE K DA,DIE,DR
|
|---|
| 41 | S PHARM1=NUR1,QTY=PSDQ
|
|---|
| 42 | S:$G(NAOUN)']"" NAOUN=$P($G(^PSD(58.8,NAOU,0)),U) D ^PSDRFM
|
|---|
| 43 | Q
|
|---|
