- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSREF 1833 printed Jan 18, 2025@03:34:59 Page 2
- 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