- 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 ---[H[J[2J[HPSOFUNC 1651 printed Jan 18, 2025@03:30:40 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