PSOFUNC.m

PSOFUNC ;BHAM ISC/DRI - functions moved from the psf global ;08/23/17  19:56

 ;;7.0;OUTPATIENT PHARMACY;**146,223,249,251,441**;DEC 1997;Build 208

STAT ;gets status of rx

 S ST0=+$P(RX0,"^",15) I ST0<12,$O(^PS(52.5,"B",J,0)),$D(^PS(52.5,+$O(^(0)),0)),'$G(^("P")) S ST0=5

 I ST0<12,$P(RX2,"^",6)<DT S ST0=11

 S ST=$P("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued By Provider^Discontinued (Edit)^Provider Hold^","^",ST0+2),$P(RX0,"^",15)=ST0

 I ST="Active" I $G(^PSRX(J,"PARK")) S ST="Active/Parked"  ;441 PAPI

 Q

CUTDATE ;calculates exp/cancel cutoff date in PSODTCUT

 S X1=DT,X2=-120 D C^%DTC S PSODTCUT=X,PSOPRPAS=$P($G(PSOPAR),"^",7) Q

 ;

FIXEXPDT ;calculate expiration date on rx's missing them

 F J=0:0 S J=$O(^PSRX(J)) Q:'J  I $D(^(J,0))#2 S RX0=^(0),RX2=$S($D(^(2))#2:^(2),1:"") D ^PSOEXDT:'$P(RX2,"^",6)

 Q

 ;

INP526 ;input transform for drug field (#6) in prescription file (#52)

 ;

 S PSODFN=+$P(^PSRX(DA,0),"^",2) F I=0:0 S I=$O(^PS(55,PSODFN,"P",I)) Q:'I  S RX=+^(I,0) I RX'=DA,$D(^PSRX(RX,0)),+$P(^(0),"^",6)=X,'$P(^("STA"),"^") S XS=X,X2=$P(^(0),"^",13),X1=$P(^PSRX(DA,0),"^",13) D ^%DTC D:X<180 INP5261 Q:'$D(X)  S X=XS

 Q

INP5261 D EN^DDIOL("Duplicate Drug in Rx #"_$P(^PSRX(RX,0),"^")_" . Discontinue? (Y/N): ","","$C(7),?10") R ZX:DTIME

 I ZX["^" D EN^DDIOL("NO UP ARROW ALLOWED","","!") S ZX="?"

 I ZX["?" D EN^DDIOL("Enter Y to discontinue this Prescription","","!") D EN^DDIOL(" ","","!") G INP5261

 S ZX=ZX?1"Y".E I ZX S $P(^PSRX(RX,"STA"),"^")=12,$P(^PSRX(RX,3),"^",5)=DT D CAN^PSOTPCAN(RX) D EN^DDIOL("     Discontinued") Q

 K X,XS,ZS Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOFUNC   1651     printed  Apr 09, 2024@21:30:24                                                                                                                                                                                                     Page 2

PSOFUNC   ;BHAM ISC/DRI - functions moved from the psf global ;08/23/17  19:56

 +1       ;;7.0;OUTPATIENT PHARMACY;**146,223,249,251,441**;DEC 1997;Build 208

STAT      ;gets status of rx

 +1        SET ST0=+$PIECE(RX0,"^",15)

           IF ST0<12

               IF $ORDER(^PS(52.5,"B",J,0))

                   IF $DATA(^PS(52.5,+$ORDER(^(0)),0))

                       IF '$GET(^("P"))

                           SET ST0=5

 +2        IF ST0<12

               IF $PIECE(RX2,"^",6)<DT

                   SET ST0=11

 +3        SET ST=$PIECE("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued By Provider^Discontinued (Edit)^Provider Hold^","^",ST0+2)

           SET $PIECE(RX0,"^",15)=ST0

 +4       ;441 PAPI

           IF ST="Active"

               IF $GET(^PSRX(J,"PARK"))

                   SET ST="Active/Parked"

 +5        QUIT 

CUTDATE   ;calculates exp/cancel cutoff date in PSODTCUT

 +1        SET X1=DT

           SET X2=-120

           DO C^%DTC

           SET PSODTCUT=X

           SET PSOPRPAS=$PIECE($GET(PSOPAR),"^",7)

           QUIT 

 +2       ;

FIXEXPDT  ;calculate expiration date on rx's missing them

 +1        FOR J=0:0

               SET J=$ORDER(^PSRX(J))

               if 'J

                   QUIT 

               IF $DATA(^(J,0))#2

                   SET RX0=^(0)

                   SET RX2=$SELECT($DATA(^(2))#2:^(2),1:"")

                   if '$PIECE(RX2,"^",6)

                       DO ^PSOEXDT

 +2        QUIT 

 +3       ;

INP526    ;input transform for drug field (#6) in prescription file (#52)

 +1       ;

 +2        SET PSODFN=+$PIECE(^PSRX(DA,0),"^",2)

           FOR I=0:0

               SET I=$ORDER(^PS(55,PSODFN,"P",I))

               if 'I

                   QUIT 

               SET RX=+^(I,0)

               IF RX'=DA

                   IF $DATA(^PSRX(RX,0))

                       IF +$PIECE(^(0),"^",6)=X

                           IF '$PIECE(^("STA"),"^")

                               SET XS=X

                               SET X2=$PIECE(^(0),"^",13)

                               SET X1=$PIECE(^PSRX(DA,0),"^",13)

                               DO ^%DTC

                               if X<180

                                   DO INP5261

                               if '$DATA(X)

                                   QUIT 

                               SET X=XS

 +3        QUIT 

INP5261    DO EN^DDIOL("Duplicate Drug in Rx #"_$PIECE(^PSRX(RX,0),"^")_" . Discontinue? (Y/N): ","","$C(7),?10")

           READ ZX:DTIME

 +1        IF ZX["^"

               DO EN^DDIOL("NO UP ARROW ALLOWED","","!")

               SET ZX="?"

 +2        IF ZX["?"

               DO EN^DDIOL("Enter Y to discontinue this Prescription","","!")

               DO EN^DDIOL(" ","","!")

               GOTO INP5261

 +3        SET ZX=ZX?1"Y".E

           IF ZX

               SET $PIECE(^PSRX(RX,"STA"),"^")=12

               SET $PIECE(^PSRX(RX,3),"^",5)=DT

               DO CAN^PSOTPCAN(RX)

               DO EN^DDIOL("     Discontinued")

               QUIT 

 +4        KILL X,XS,ZS

           QUIT