PSSORUTE ;OIFO BAY PINES/ELR-CONTINUATION OF PSSORUTL ;07/20/04
;;1.0;PHARMACY DATA MANAGEMENT;**83,93,187**;9/30/97;Build 27
;
;Reference to ^PS(52.41 is supported by DBIA # 2844.
;Reference to ^PSRX is supported by DBIA # 2845.
;Reference to ^PS(53.1 is supported by DBIA # 2140.
;
NU S PSONDU=$S($G(PSONDS)&($G(PSONDU)):$P($G(^PS(50.607,+$G(PSONDU),0)),"^"),1:"")
Q
SETU S PSSUNITX=$P($G(^PSDRUG(PSIEN,"DOS")),"^",2)
S PSSUNITX=$S($P($G(^PS(50.607,+$G(PSSUNITX),0)),"^")'=""&($P($G(^(0)),"^")'["/"):$P($G(^(0)),"^"),1:"")
Q
STATUS(PSSDFN,PSSON) ;Return the status of the Pharmacy order
;
N ST,TYPE,LEN,PKG,A,STO,RX2,STA,%,Y
D NOW^%DTC S %=$P(%,".") I $P(PSSON,";",2)="" Q ""
S LEN=$L($P(PSSON,";")),PKG=$P(PSSON,";",2) I PSSON?.N S TYPE="O"
I PSSON'?.N S TYPE=$E(PSSON,LEN),PSSON=$E(PSSON,1,LEN-1)
I PKG="I" D Q ST
. I TYPE="P" S A=$P($G(^PS(53.1,PSSON,0)),"^",9),ST=$$CODES(A,53.1,28) Q
. I TYPE="V" S A=$P($G(^PS(55,PSSDFN,"IV",PSSON,0)),"^",17),ST=$$CODES(A,55.01,100) Q
. I TYPE="U" S A=$P($G(^PS(55,PSSDFN,5,PSSON,0)),"^",9),ST=$$CODES(A,55.06,28)
I PKG="O" D Q ST
. I TYPE="P"!(TYPE="S") D Q
.. S A=$P($G(^PS(52.41,PSSON,0)),"^",3),ST="" I A]"" S ST="PENDING" Q
. I TYPE="N" S A=$P(^PS(55,PSSDFN,"NVA",PSSON,0),"^",7) S ST=$S('A:"ACTIVE",1:"DISCONTINUED") Q
. I TYPE="R"!(TYPE="O") S RX2=$G(^PSRX(PSSON,2)),STA=$G(^PSRX(PSSON,"STA")),STO=$S(STA<12&($P(RX2,"^",6)<%):11,1:STA)
. S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^NON-VERIFIED^ACTIVE/SUSP^^^^^DONE^EXPIRED^DISCONTINUED^DISCONTINUED^DISCONTINUED^DISCONTINUED (EDIT)^HOLD^","^",STO+2)
. I ST="ACTIVE",+$G(^PSRX(PSSON,"PARK")) S ST="ACTIVE/PARKED" ;ADDED PAPI CODE
Q ""
CODES(PSSCD,PSSF,PSSFLD) ; Get name from code.
; PSSF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6, ^PS(52.41
N PSSDD,Y
D FIELD^DID(PSSF,PSSFLD,"","POINTER","PSSDD")
S Y=$G(PSSDD("POINTER")) K PSSDD
S Y=$P($P(";"_Y,";"_PSSCD_":",2),";")
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSORUTE 1965 printed Oct 16, 2024@18:34:11 Page 2
PSSORUTE ;OIFO BAY PINES/ELR-CONTINUATION OF PSSORUTL ;07/20/04
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**83,93,187**;9/30/97;Build 27
+2 ;
+3 ;Reference to ^PS(52.41 is supported by DBIA # 2844.
+4 ;Reference to ^PSRX is supported by DBIA # 2845.
+5 ;Reference to ^PS(53.1 is supported by DBIA # 2140.
+6 ;
NU SET PSONDU=$SELECT($GET(PSONDS)&($GET(PSONDU)):$PIECE($GET(^PS(50.607,+$GET(PSONDU),0)),"^"),1:"")
+1 QUIT
SETU SET PSSUNITX=$PIECE($GET(^PSDRUG(PSIEN,"DOS")),"^",2)
+1 SET PSSUNITX=$SELECT($PIECE($GET(^PS(50.607,+$GET(PSSUNITX),0)),"^")'=""&($PIECE($GET(^(0)),"^")'["/"):$PIECE($GET(^(0)),"^"),1:"")
+2 QUIT
STATUS(PSSDFN,PSSON) ;Return the status of the Pharmacy order
+1 ;
+2 NEW ST,TYPE,LEN,PKG,A,STO,RX2,STA,%,Y
+3 DO NOW^%DTC
SET %=$PIECE(%,".")
IF $PIECE(PSSON,";",2)=""
QUIT ""
+4 SET LEN=$LENGTH($PIECE(PSSON,";"))
SET PKG=$PIECE(PSSON,";",2)
IF PSSON?.N
SET TYPE="O"
+5 IF PSSON'?.N
SET TYPE=$EXTRACT(PSSON,LEN)
SET PSSON=$EXTRACT(PSSON,1,LEN-1)
+6 IF PKG="I"
Begin DoDot:1
+7 IF TYPE="P"
SET A=$PIECE($GET(^PS(53.1,PSSON,0)),"^",9)
SET ST=$$CODES(A,53.1,28)
QUIT
+8 IF TYPE="V"
SET A=$PIECE($GET(^PS(55,PSSDFN,"IV",PSSON,0)),"^",17)
SET ST=$$CODES(A,55.01,100)
QUIT
+9 IF TYPE="U"
SET A=$PIECE($GET(^PS(55,PSSDFN,5,PSSON,0)),"^",9)
SET ST=$$CODES(A,55.06,28)
End DoDot:1
QUIT ST
+10 IF PKG="O"
Begin DoDot:1
+11 IF TYPE="P"!(TYPE="S")
Begin DoDot:2
+12 SET A=$PIECE($GET(^PS(52.41,PSSON,0)),"^",3)
SET ST=""
IF A]""
SET ST="PENDING"
QUIT
End DoDot:2
QUIT
+13 IF TYPE="N"
SET A=$PIECE(^PS(55,PSSDFN,"NVA",PSSON,0),"^",7)
SET ST=$SELECT('A:"ACTIVE",1:"DISCONTINUED")
QUIT
+14 IF TYPE="R"!(TYPE="O")
SET RX2=$GET(^PSRX(PSSON,2))
SET STA=$GET(^PSRX(PSSON,"STA"))
SET STO=$SELECT(STA<12&($PIECE(RX2,"^",6)<%):11,1:STA)
+15 SET ST=$PIECE("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^NON-VERIFIED^ACTIVE/SUSP^^^^^DONE^EXPIRED^DISCONTINUED^DISCONTINUED^DISCONTINUED^DISCONTINUED (EDIT)^HOLD^","^",STO+2)
+16 ;ADDED PAPI CODE
IF ST="ACTIVE"
IF +$GET(^PSRX(PSSON,"PARK"))
SET ST="ACTIVE/PARKED"
End DoDot:1
QUIT ST
+17 QUIT ""
CODES(PSSCD,PSSF,PSSFLD) ; Get name from code.
+1 ; PSSF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6, ^PS(52.41
+2 NEW PSSDD,Y
+3 DO FIELD^DID(PSSF,PSSFLD,"","POINTER","PSSDD")
+4 SET Y=$GET(PSSDD("POINTER"))
KILL PSSDD
+5 SET Y=$PIECE($PIECE(";"_Y,";"_PSSCD_":",2),";")
+6 QUIT Y
