PSSREF.m

PSSREF ;BIR/BAB-Cross Reference Utility ; 09/02/97 8:49

 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97

ACT ;Entry point to create xref for CMOP Dispense field edit

 Q:$G(^PSDRUG(DA,3))=""

 S:'$D(^PSDRUG(DA,4,0)) ^PSDRUG(DA,4,0)="^50.0214DA^^"

 S (PSX,Z)=0 F  S Z=$O(^PSDRUG(DA,4,Z)) Q:'Z  S PSX=Z

 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:"")

 S $P(^PSDRUG(DA,4,0),"^",3)=PSX,$P(^(0),"^",4)=$P(^(0),"^",4)+1

 K PSX,Z,% Q

DEL ;  Called by ^DD(52.1,.01,"DEL",550,0)- PREVENTS DELETING REFILL DATE

 I $G(PSX(DA))]"",($G(PSX(DA))="L"!(+$G(PSX(DA))'=3)) D

 .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",!!

 Q

AR ; Sets the "AR" xref if CMOP status in 52 =1      

 ; ^PSRX("AR",RELEASE D/T,INTERNAL ENTRY # RX in 52,fill #

 I X=1 D

 .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))=""

 .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

 ..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))=""

 Q

AS ; Transmission D/T xref

 ; ^PSRX("AS",TRANS D/T,INTERNAL ENTRY # RX in 52, fill #

 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))=""

 Q

ASKILL ;

 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))

 Q

DISPUNIT ;Called by ^DD(50,14.5,"DEL",0) to prevent deleting CMOP disp units. 

 I $D(^PSDRUG("AQ",DA)) W !,"The Dispense Unit of a CMOP drug cannot be deleted!",!

 Q

PSSREF    ;BIR/BAB-Cross Reference Utility ; 09/02/97 8:49

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97

ACT       ;Entry point to create xref for CMOP Dispense field edit

 +1        IF $GET(^PSDRUG(DA,3))=""

               QUIT 

 +2        IF '$DATA(^PSDRUG(DA,4,0))

               SET ^PSDRUG(DA,4,0)="^50.0214DA^^"

 +3        SET (PSX,Z)=0

           FOR 

               SET Z=$ORDER(^PSDRUG(DA,4,Z))

               IF 'Z

                   QUIT 

               SET PSX=Z

 +4        SET PSX=PSX+1

           DO NOW^%DTC

           SET ^PSDRUG(DA,4,PSX,0)=%_"^E^"_DUZ_"^CMOP Dispense^"_$SELECT($GET(^PSDRUG(DA,3))=1:"YES",$GET(^PSDRUG(DA,3))=0:"NO",1:"")

 +5        SET $PIECE(^PSDRUG(DA,4,0),"^",3)=PSX

           SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1

 +6        KILL PSX,Z,%

           QUIT 

DEL       ;  Called by ^DD(52.1,.01,"DEL",550,0)- PREVENTS DELETING REFILL DATE

 +1        IF $GET(PSX(DA))]""

               IF ($GET(PSX(DA))="L"!(+$GET(PSX(DA))'=3))

                   Begin DoDot:1

 +2                    WRITE !!,"You cannot delete a refill date for a fill that is"_$SELECT(+$GET(PSX(DA))=1:" released by",+$GET(PSX(DA))=0:" in transmission to",1:" being retransmitted to")_" the CMOP",!!

                   End DoDot:1

 +3        QUIT 

AR        ; Sets the "AR" xref if CMOP status in 52 =1      

 +1       ; ^PSRX("AR",RELEASE D/T,INTERNAL ENTRY # RX in 52,fill #

 +2        IF X=1

               Begin DoDot:1

 +3                IF $PIECE(^PSRX(DA(1),4,DA,0),U,3)=0

                       IF ($PIECE($GET(^PSRX(DA(1),2)),U,13))

                           SET ^PSRX("AR",$PIECE(^PSRX(DA(1),2),U,13),DA(1),$PIECE(^PSRX(DA(1),4,DA,0),U,3))=""

 +4                IF $PIECE(^PSRX(DA(1),4,DA,0),U,3)>0

                       IF ($DATA(^PSRX(DA(1),1,$PIECE(^PSRX(DA(1),4,DA,0),U,3),0)))

                           IF ($PIECE($GET(^PSRX(DA(1),1,$PIECE(^PSRX(DA(1),4,DA,0),U,3),0)),U,18)]"")

                               Begin DoDot:2

 +5                                SET ^PSRX("AR",$PIECE(^PSRX(DA(1),1,$PIECE(^PSRX(DA(1),4,DA,0),U,3),0),U,18),DA(1),$PIECE(^PSRX(DA(1),4,DA,0),U,3))=""

                               End DoDot:2

               End DoDot:1

 +6        QUIT 

AS        ; Transmission D/T xref

 +1       ; ^PSRX("AS",TRANS D/T,INTERNAL ENTRY # RX in 52, fill #

 +2        IF X=0

               SET ^PSRX("AS",$PIECE(^PSX(550.2,$PIECE(^PSRX(DA(1),4,DA,0),U),0),U,6),DA(1),$PIECE(^PSRX(DA(1),4,DA,0),U,3))=""

 +3        QUIT 

ASKILL    ;

 +1        KILL ^PSRX("AS",$PIECE(^PSX(550.2,$PIECE(^PSRX(DA(1),4,DA,0),U),0),U,6),DA(1),$PIECE(^PSRX(DA(1),4,DA,0),U,3))

 +2        QUIT 

DISPUNIT  ;Called by ^DD(50,14.5,"DEL",0) to prevent deleting CMOP disp units. 

 +1        IF $DATA(^PSDRUG("AQ",DA))

               WRITE !,"The Dispense Unit of a CMOP drug cannot be deleted!",!

 +2        QUIT