source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSREF.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PSSREF ;BIR/BAB-Cross Reference Utility ; 09/02/97 8:49
2 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
3ACT ;Entry point to create xref for CMOP Dispense field edit
4 Q:$G(^PSDRUG(DA,3))=""
5 S:'$D(^PSDRUG(DA,4,0)) ^PSDRUG(DA,4,0)="^50.0214DA^^"
6 S (PSX,Z)=0 F S Z=$O(^PSDRUG(DA,4,Z)) Q:'Z S PSX=Z
7 S PSX=PSX+1 D NOW^%DTC S ^PSDRUG(DA,4,PSX,0)=%_"^E^"_DUZ_"^CMOP Dispense^"_$S($G(^PSDRUG(DA,3))=1:"YES",$G(^PSDRUG(DA,3))=0:"NO",1:"")
8 S $P(^PSDRUG(DA,4,0),"^",3)=PSX,$P(^(0),"^",4)=$P(^(0),"^",4)+1
9 K PSX,Z,% Q
10DEL ; Called by ^DD(52.1,.01,"DEL",550,0)- PREVENTS DELETING REFILL DATE
11 I $G(PSX(DA))]"",($G(PSX(DA))="L"!(+$G(PSX(DA))'=3)) D
12 .W !!,"You cannot delete a refill date for a fill that is"_$S(+$G(PSX(DA))=1:" released by",+$G(PSX(DA))=0:" in transmission to",1:" being retransmitted to")_" the CMOP",!!
13 Q
14AR ; Sets the "AR" xref if CMOP status in 52 =1
15 ; ^PSRX("AR",RELEASE D/T,INTERNAL ENTRY # RX in 52,fill #
16 I X=1 D
17 .I $P(^PSRX(DA(1),4,DA,0),U,3)=0,($P($G(^PSRX(DA(1),2)),U,13)) S ^PSRX("AR",$P(^PSRX(DA(1),2),U,13),DA(1),$P(^PSRX(DA(1),4,DA,0),U,3))=""
18 .I $P(^PSRX(DA(1),4,DA,0),U,3)>0,($D(^PSRX(DA(1),1,$P(^PSRX(DA(1),4,DA,0),U,3),0))),($P($G(^PSRX(DA(1),1,$P(^PSRX(DA(1),4,DA,0),U,3),0)),U,18)]"") D
19 ..S ^PSRX("AR",$P(^PSRX(DA(1),1,$P(^PSRX(DA(1),4,DA,0),U,3),0),U,18),DA(1),$P(^PSRX(DA(1),4,DA,0),U,3))=""
20 Q
21AS ; Transmission D/T xref
22 ; ^PSRX("AS",TRANS D/T,INTERNAL ENTRY # RX in 52, fill #
23 I X=0 S ^PSRX("AS",$P(^PSX(550.2,$P(^PSRX(DA(1),4,DA,0),U),0),U,6),DA(1),$P(^PSRX(DA(1),4,DA,0),U,3))=""
24 Q
25ASKILL ;
26 K ^PSRX("AS",$P(^PSX(550.2,$P(^PSRX(DA(1),4,DA,0),U),0),U,6),DA(1),$P(^PSRX(DA(1),4,DA,0),U,3))
27 Q
28DISPUNIT ;Called by ^DD(50,14.5,"DEL",0) to prevent deleting CMOP disp units.
29 I $D(^PSDRUG("AQ",DA)) W !,"The Dispense Unit of a CMOP drug cannot be deleted!",!
30 Q
Note: See TracBrowser for help on using the repository browser.