Routine: PSSORUTE

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

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

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  Apr 23, 2025@18:47:29                                                                                                                                                                                                    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

PSSORUTE.m