PSOERBT2 ;ALB/RM - PSO ERX UTILITIES ;Jan 16, 2025@12:43:34
;;7.0;OUTPATIENT PHARMACY;**770**;DEC 16, 1997;Build 145
;
;
Q ;No Direct Call
;
LSTCHREQ(ERXIEN) ;Get last change erx change request date
;Input: ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
;Output: Last Change Request Submission Date (YYYMMDD) or ""
N LSTCHREQ,CHERXIEN
I '$G(ERXIEN) Q ""
S (LSTCHREQ,CHERXIEN)="" F S CHERXIEN=$O(^PS(52.49,ERXIEN,201,"B",CHERXIEN),-1) Q:'CHERXIEN!LSTCHREQ D
. I $$GET1^DIQ(52.49,CHERXIEN,.08,"I")="CR" S LSTCHREQ=$$GET1^DIQ(52.49,CHERXIEN,.03,"I")\1,FOUND=1
Q LSTCHREQ
;
ISCMOPD(RXIEN) ;
; Input: RXIEN - Pointer to the PRESCRIPTION file (#52)
;Return: CMOP Indicatior - ">" CMOP dispense | "T" CMOP Loading for Transmission/Retransmission
Q:$G(RXIEN)=""
N PSOCMOP
S PSOCMOP=""
I $D(^PSDRUG("AQ",$P(^PSRX(RXIEN,0),"^",6))) S PSOCMOP=">" ;cmop indicator
N X S X="PSXOPUTL" X ^%ZOSF("TEST") K X I $T D
. N DA S DA=+RXIEN D ^PSXOPUTL K DA
. I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S PSOCMOP="T"
. K PSXZ
Q $G(PSOCMOP)
;
GETLSTFL(RXIEN) ;get the last fill date
;Input : RXIEN - Pointer to the PRESCRIPTION file (#52)
;Output: PSOLF - Last Fill Date
N RFLZRO,PSOLRD,PSOLF,PSORFG S PSOLRD=$P($G(^PSRX(+RXIEN,2)),"^",13),PSOLF=+$G(^(3))
F PSOX=0:0 S PSOX=$O(^PSRX(+RXIEN,1,PSOX)) Q:'PSOX D
. S RFLZRO=$G(^PSRX(+RXIEN,1,PSOX,0))
. I +RFLZRO=PSOLF,$P(RFLZRO,"^",16) S PSOLF=PSOLF_"^R"
. S:$P(RFLZRO,"^",18)'="" PSOLRD=$P(RFLZRO,"^",18) I $P(RFLZRO,"^",16) S PSOLRD=PSOLRD_"^R"
K PSOX
I '$O(^PSRX(+RXIEN,1,0)),$P(^PSRX(+RXIEN,2),"^",15) S PSOLF=PSOLF_"^R",PSOLRD=PSOLRD_"^R"
S PSOLF=PSOLF_$S($P(PSOLF,"^",2)="R":"R ",1:" ")
S PSOLRD=PSOLRD_$S($P(PSOLRD,"^",2)="R":"R ",1:" ")
Q $S($G(PSORFG):PSOLRD,1:PSOLF)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERBT2 1805 printed Aug 26, 2025@22:43:42 Page 2
PSOERBT2 ;ALB/RM - PSO ERX UTILITIES ;Jan 16, 2025@12:43:34
+1 ;;7.0;OUTPATIENT PHARMACY;**770**;DEC 16, 1997;Build 145
+2 ;
+3 ;
+4 ;No Direct Call
QUIT
+5 ;
LSTCHREQ(ERXIEN) ;Get last change erx change request date
+1 ;Input: ERXIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+2 ;Output: Last Change Request Submission Date (YYYMMDD) or ""
+3 NEW LSTCHREQ,CHERXIEN
+4 IF '$GET(ERXIEN)
QUIT ""
+5 SET (LSTCHREQ,CHERXIEN)=""
FOR
SET CHERXIEN=$ORDER(^PS(52.49,ERXIEN,201,"B",CHERXIEN),-1)
if 'CHERXIEN!LSTCHREQ
QUIT
Begin DoDot:1
+6 IF $$GET1^DIQ(52.49,CHERXIEN,.08,"I")="CR"
SET LSTCHREQ=$$GET1^DIQ(52.49,CHERXIEN,.03,"I")\1
SET FOUND=1
End DoDot:1
+7 QUIT LSTCHREQ
+8 ;
ISCMOPD(RXIEN) ;
+1 ; Input: RXIEN - Pointer to the PRESCRIPTION file (#52)
+2 ;Return: CMOP Indicatior - ">" CMOP dispense | "T" CMOP Loading for Transmission/Retransmission
+3 if $GET(RXIEN)=""
QUIT
+4 NEW PSOCMOP
+5 SET PSOCMOP=""
+6 ;cmop indicator
IF $DATA(^PSDRUG("AQ",$PIECE(^PSRX(RXIEN,0),"^",6)))
SET PSOCMOP=">"
+7 NEW X
SET X="PSXOPUTL"
XECUTE ^%ZOSF("TEST")
KILL X
IF $TEST
Begin DoDot:1
+8 NEW DA
SET DA=+RXIEN
DO ^PSXOPUTL
KILL DA
+9 IF $GET(PSXZ(PSXZ("L")))=0!($GET(PSXZ(PSXZ("L")))=2)
SET PSOCMOP="T"
+10 KILL PSXZ
End DoDot:1
+11 QUIT $GET(PSOCMOP)
+12 ;
GETLSTFL(RXIEN) ;get the last fill date
+1 ;Input : RXIEN - Pointer to the PRESCRIPTION file (#52)
+2 ;Output: PSOLF - Last Fill Date
+3 NEW RFLZRO,PSOLRD,PSOLF,PSORFG
SET PSOLRD=$PIECE($GET(^PSRX(+RXIEN,2)),"^",13)
SET PSOLF=+$GET(^(3))
+4 FOR PSOX=0:0
SET PSOX=$ORDER(^PSRX(+RXIEN,1,PSOX))
if 'PSOX
QUIT
Begin DoDot:1
+5 SET RFLZRO=$GET(^PSRX(+RXIEN,1,PSOX,0))
+6 IF +RFLZRO=PSOLF
IF $PIECE(RFLZRO,"^",16)
SET PSOLF=PSOLF_"^R"
+7 if $PIECE(RFLZRO,"^",18)'=""
SET PSOLRD=$PIECE(RFLZRO,"^",18)
IF $PIECE(RFLZRO,"^",16)
SET PSOLRD=PSOLRD_"^R"
End DoDot:1
+8 KILL PSOX
+9 IF '$ORDER(^PSRX(+RXIEN,1,0))
IF $PIECE(^PSRX(+RXIEN,2),"^",15)
SET PSOLF=PSOLF_"^R"
SET PSOLRD=PSOLRD_"^R"
+10 SET PSOLF=PSOLF_$SELECT($PIECE(PSOLF,"^",2)="R":"R ",1:" ")
+11 SET PSOLRD=PSOLRD_$SELECT($PIECE(PSOLRD,"^",2)="R":"R ",1:" ")
+12 QUIT $SELECT($GET(PSORFG):PSOLRD,1:PSOLF)
+13 ;
