PSO52EX ;BHAM ISC/AGV - API FOR ORIGINAL, REFILL, AND PARTIAL DATA ;06/03/16 17:07
;;7.0;OUTPATIENT PHARMACY;**252,267,441**;DEC 1997;Build 208
;
;REFERENCE TO ^DPT SUPPORTED BY DBIA 10035
;REFERENCE TO ^PSDRUG SUPPORTED BY DBIA 221
;
;
;SDATE: START DATE OF RECORD RETRIEVAL [REQUIRED]
;EDATE: END DATE OF RECORD RETRIEVAL [OPTIONAL]
;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
;
Q:$G(LIST)=""
K ^TMP($J,LIST)
I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
I '$G(EDATE) S EDATE=DT
D SEND
Q
;
SEND ;SENDS CONTROL TO $$CROSS. RECEIVES AND TRACKS COUNTS.
N ALCOUNT S ALCOUNT=$$CROSS("AL")
N AMCOUNT S AMCOUNT=$$CROSS("AM")
N TCOUNT S TCOUNT=ALCOUNT+AMCOUNT
IF TCOUNT>0 S ^TMP($J,LIST,0)=TCOUNT
ELSE S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
Q
;
CROSS(REF) ;SETS UP ^TMP GLOBAL. SENDS FOR ORIGINAL, REFILL AND/OR PARTIAL FILL DATA
N PSOIEN,PSOFILL,PSOCOUNT,DATE,END
S DATE=SDATE-.001,END=(EDATE+1),PSOIEN="",PSOFILL="",PSOCOUNT=0
F S DATE=$O(^PSRX(REF,DATE)) Q:'DATE!(END'>DATE) D
.F S PSOIEN=$O(^PSRX(REF,DATE,PSOIEN)) Q:'PSOIEN D
..F S PSOFILL=$O(^PSRX(REF,DATE,PSOIEN,PSOFILL)) Q:PSOFILL="" D
...S ^TMP($J,LIST,REF,DATE,PSOIEN,PSOFILL)=""
...I REF="AL",PSOFILL=0 S PSOCOUNT=PSOCOUNT+1 D ORIG(PSOIEN) Q
...I REF="AL",PSOFILL>0 S PSOCOUNT=PSOCOUNT+1 D REFILL(PSOIEN,PSOFILL) Q
...I REF="AM" S PSOCOUNT=PSOCOUNT+1 D PART(PSOIEN,PSOFILL) Q
Q PSOCOUNT
;
REFILL(IEN,FILL) ;REFILL
D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
N PSORFL S PSORFL=$G(^PSRX(IEN,1,FILL,0))
S ^TMP($J,LIST,IEN,"RF",FILL,.01)=$P(PSORFL,U,1)_"^"_$$FMTE^XLFDT($P(PSORFL,U,1),1)
S ^TMP($J,LIST,IEN,"RF",FILL,1)=$P(PSORFL,U,4)
S ^TMP($J,LIST,IEN,"RF",FILL,1.1)=$P(PSORFL,U,10)
S ^TMP($J,LIST,IEN,"RF",FILL,1.2)=$P(PSORFL,U,11)
S ^TMP($J,LIST,IEN,"RF",0)=$G(^TMP($J,LIST,IEN,"RF",0))+1
Q
;
PART(IEN,FILL) ;PARTIAL FILL
D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
N PSOPART S PSOPART=$G(^PSRX(IEN,"P",FILL,0))
S ^TMP($J,LIST,IEN,"P",FILL,.01)=$P(PSOPART,U,1)_"^"_$$FMTE^XLFDT($P(PSOPART,U,1),1)
S ^TMP($J,LIST,IEN,"P",FILL,.04)=$P(PSOPART,U,4)
S ^TMP($J,LIST,IEN,"P",FILL,.041)=$P(PSOPART,U,10)
S ^TMP($J,LIST,IEN,"P",FILL,.042)=$P(PSOPART,U,11)
S ^TMP($J,LIST,IEN,"P",0)=$G(^TMP($J,LIST,IEN,"P",0))+1
Q
;
ORIG(IEN) ;ORIGINAL FILL
N PSOORIG S PSOORIG=$G(^PSRX(IEN,0))
S ^TMP($J,LIST,IEN,.01)=$P(PSOORIG,U,1)
S ^TMP($J,LIST,IEN,2)=$S($P(PSOORIG,U,2)>0:$P(PSOORIG,U,2)_"^"_$P($G(^DPT($P($G(PSOORIG),U,2),0)),U,1),1:"")
S ^TMP($J,LIST,IEN,6)=$S($P(PSOORIG,U,6)>0:$P(PSOORIG,U,6)_"^"_$P($G(^PSDRUG($P($G(PSOORIG),U,6),0)),U,1),1:"")
S ^TMP($J,LIST,IEN,7)=$P(PSOORIG,U,7)
S ^TMP($J,LIST,IEN,8)=$P(PSOORIG,U,8)
S ^TMP($J,LIST,IEN,17)=$P(PSOORIG,U,17)
Q
;
REF(SDATE,EDATE,LIST) ; "AD" XREF RETRIEVAL
;SDATE: START DATE OF "AD" XREF RETRIEVAL [REQUIRED]
;EDATE: END DATE OF "AD" XREF RETRIEVAL [OPTIONAL]
;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
;
Q:$G(LIST)=""
K ^TMP($J,LIST)
I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
I '$G(EDATE) S EDATE=SDATE
N PSORXN,PSOFILL
S DATE=SDATE-.001,END=EDATE+1,PSORXN="",PSOFILL=""
F S DATE=$O(^PSRX("AD",DATE)) Q:'DATE!(END'>DATE) D
.F S PSORXN=$O(^PSRX("AD",DATE,PSORXN)) Q:'PSORXN D
..F S PSOFILL=$O(^PSRX("AD",DATE,PSORXN,PSOFILL)) Q:PSOFILL="" D
...S ^TMP($J,LIST,"AD",DATE,PSORXN,PSOFILL)=""
Q
;
ARXREF(PSODATE,PSOIEN,PSOFILL) ; SUSPENSE STATUS CHECK
;PSODATE: RELEASED DATE/TIME
;PSOIEN: INTERNAL ENTRY NUMBER
;PSOFILL: FILL NUMBER OF PRESCRIPTION
;
I $G(PSODATE)=""!($G(PSOIEN)="")!($G(PSOFILL)="") Q 0
N RESULT S RESULT=0
I $D(^PSRX("AR",PSODATE,PSOIEN,PSOFILL)) S RESULT=1
Q RESULT
;
PARK(ORIEN) ; DETERMINES IF A PRESCRIPTION IS PARK
;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
;
I $G(ORIEN)="" Q 0
N PSOIEN
S PSOIEN=$O(^PSRX("APL",ORIEN,""))
I +PSOIEN=0 Q 0
I $G(^PSRX(PSOIEN,"STA"))'=0 Q 0
N RESULT S RESULT=0
I $G(^PSRX(PSOIEN,"PARK"))=1 S RESULT=1
Q RESULT
SUSP(ORIEN) ; DETERMINES IF A PRESCRIPTION IS SUSPENDED
;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
;
I $G(ORIEN)="" Q 0
N PSOIEN
S PSOIEN=$O(^PSRX("APL",ORIEN,""))
I +PSOIEN=0 Q 0
I $G(^PSRX(PSOIEN,"STA"))=5 Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO52EX 4287 printed Sep 23, 2025@19:59:20 Page 2
PSO52EX ;BHAM ISC/AGV - API FOR ORIGINAL, REFILL, AND PARTIAL DATA ;06/03/16 17:07
+1 ;;7.0;OUTPATIENT PHARMACY;**252,267,441**;DEC 1997;Build 208
+2 ;
+3 ;REFERENCE TO ^DPT SUPPORTED BY DBIA 10035
+4 ;REFERENCE TO ^PSDRUG SUPPORTED BY DBIA 221
+5 ;
+6 ;
+1 ;SDATE: START DATE OF RECORD RETRIEVAL [REQUIRED]
+2 ;EDATE: END DATE OF RECORD RETRIEVAL [OPTIONAL]
+3 ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
+4 ;
+5 if $GET(LIST)=""
QUIT
+6 KILL ^TMP($JOB,LIST)
+7 IF '$GET(SDATE)
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
QUIT
+8 IF '$GET(EDATE)
SET EDATE=DT
+9 DO SEND
+10 QUIT
+11 ;
SEND ;SENDS CONTROL TO $$CROSS. RECEIVES AND TRACKS COUNTS.
+1 NEW ALCOUNT
SET ALCOUNT=$$CROSS("AL")
+2 NEW AMCOUNT
SET AMCOUNT=$$CROSS("AM")
+3 NEW TCOUNT
SET TCOUNT=ALCOUNT+AMCOUNT
+4 IF TCOUNT>0
SET ^TMP($JOB,LIST,0)=TCOUNT
+5 IF '$TEST
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
+6 QUIT
+7 ;
CROSS(REF) ;SETS UP ^TMP GLOBAL. SENDS FOR ORIGINAL, REFILL AND/OR PARTIAL FILL DATA
+1 NEW PSOIEN,PSOFILL,PSOCOUNT,DATE,END
+2 SET DATE=SDATE-.001
SET END=(EDATE+1)
SET PSOIEN=""
SET PSOFILL=""
SET PSOCOUNT=0
+3 FOR
SET DATE=$ORDER(^PSRX(REF,DATE))
if 'DATE!(END'>DATE)
QUIT
Begin DoDot:1
+4 FOR
SET PSOIEN=$ORDER(^PSRX(REF,DATE,PSOIEN))
if 'PSOIEN
QUIT
Begin DoDot:2
+5 FOR
SET PSOFILL=$ORDER(^PSRX(REF,DATE,PSOIEN,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:3
+6 SET ^TMP($JOB,LIST,REF,DATE,PSOIEN,PSOFILL)=""
+7 IF REF="AL"
IF PSOFILL=0
SET PSOCOUNT=PSOCOUNT+1
DO ORIG(PSOIEN)
QUIT
+8 IF REF="AL"
IF PSOFILL>0
SET PSOCOUNT=PSOCOUNT+1
DO REFILL(PSOIEN,PSOFILL)
QUIT
+9 IF REF="AM"
SET PSOCOUNT=PSOCOUNT+1
DO PART(PSOIEN,PSOFILL)
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT PSOCOUNT
+11 ;
REFILL(IEN,FILL) ;REFILL
+1 if '$DATA(^TMP($JOB,LIST,IEN,.01))
DO ORIG(IEN)
+2 NEW PSORFL
SET PSORFL=$GET(^PSRX(IEN,1,FILL,0))
+3 SET ^TMP($JOB,LIST,IEN,"RF",FILL,.01)=$PIECE(PSORFL,U,1)_"^"_$$FMTE^XLFDT($PIECE(PSORFL,U,1),1)
+4 SET ^TMP($JOB,LIST,IEN,"RF",FILL,1)=$PIECE(PSORFL,U,4)
+5 SET ^TMP($JOB,LIST,IEN,"RF",FILL,1.1)=$PIECE(PSORFL,U,10)
+6 SET ^TMP($JOB,LIST,IEN,"RF",FILL,1.2)=$PIECE(PSORFL,U,11)
+7 SET ^TMP($JOB,LIST,IEN,"RF",0)=$GET(^TMP($JOB,LIST,IEN,"RF",0))+1
+8 QUIT
+9 ;
PART(IEN,FILL) ;PARTIAL FILL
+1 if '$DATA(^TMP($JOB,LIST,IEN,.01))
DO ORIG(IEN)
+2 NEW PSOPART
SET PSOPART=$GET(^PSRX(IEN,"P",FILL,0))
+3 SET ^TMP($JOB,LIST,IEN,"P",FILL,.01)=$PIECE(PSOPART,U,1)_"^"_$$FMTE^XLFDT($PIECE(PSOPART,U,1),1)
+4 SET ^TMP($JOB,LIST,IEN,"P",FILL,.04)=$PIECE(PSOPART,U,4)
+5 SET ^TMP($JOB,LIST,IEN,"P",FILL,.041)=$PIECE(PSOPART,U,10)
+6 SET ^TMP($JOB,LIST,IEN,"P",FILL,.042)=$PIECE(PSOPART,U,11)
+7 SET ^TMP($JOB,LIST,IEN,"P",0)=$GET(^TMP($JOB,LIST,IEN,"P",0))+1
+8 QUIT
+9 ;
ORIG(IEN) ;ORIGINAL FILL
+1 NEW PSOORIG
SET PSOORIG=$GET(^PSRX(IEN,0))
+2 SET ^TMP($JOB,LIST,IEN,.01)=$PIECE(PSOORIG,U,1)
+3 SET ^TMP($JOB,LIST,IEN,2)=$SELECT($PIECE(PSOORIG,U,2)>0:$PIECE(PSOORIG,U,2)_"^"_$PIECE($GET(^DPT($PIECE($GET(PSOORIG),U,2),0)),U,1),1:"")
+4 SET ^TMP($JOB,LIST,IEN,6)=$SELECT($PIECE(PSOORIG,U,6)>0:$PIECE(PSOORIG,U,6)_"^"_$PIECE($GET(^PSDRUG($PIECE($GET(PSOORIG),U,6),0)),U,1),1:"")
+5 SET ^TMP($JOB,LIST,IEN,7)=$PIECE(PSOORIG,U,7)
+6 SET ^TMP($JOB,LIST,IEN,8)=$PIECE(PSOORIG,U,8)
+7 SET ^TMP($JOB,LIST,IEN,17)=$PIECE(PSOORIG,U,17)
+8 QUIT
+9 ;
REF(SDATE,EDATE,LIST) ; "AD" XREF RETRIEVAL
+1 ;SDATE: START DATE OF "AD" XREF RETRIEVAL [REQUIRED]
+2 ;EDATE: END DATE OF "AD" XREF RETRIEVAL [OPTIONAL]
+3 ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
+4 ;
+5 if $GET(LIST)=""
QUIT
+6 KILL ^TMP($JOB,LIST)
+7 IF '$GET(SDATE)
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
QUIT
+8 IF '$GET(EDATE)
SET EDATE=SDATE
+9 NEW PSORXN,PSOFILL
+10 SET DATE=SDATE-.001
SET END=EDATE+1
SET PSORXN=""
SET PSOFILL=""
+11 FOR
SET DATE=$ORDER(^PSRX("AD",DATE))
if 'DATE!(END'>DATE)
QUIT
Begin DoDot:1
+12 FOR
SET PSORXN=$ORDER(^PSRX("AD",DATE,PSORXN))
if 'PSORXN
QUIT
Begin DoDot:2
+13 FOR
SET PSOFILL=$ORDER(^PSRX("AD",DATE,PSORXN,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:3
+14 SET ^TMP($JOB,LIST,"AD",DATE,PSORXN,PSOFILL)=""
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
ARXREF(PSODATE,PSOIEN,PSOFILL) ; SUSPENSE STATUS CHECK
+1 ;PSODATE: RELEASED DATE/TIME
+2 ;PSOIEN: INTERNAL ENTRY NUMBER
+3 ;PSOFILL: FILL NUMBER OF PRESCRIPTION
+4 ;
+5 IF $GET(PSODATE)=""!($GET(PSOIEN)="")!($GET(PSOFILL)="")
QUIT 0
+6 NEW RESULT
SET RESULT=0
+7 IF $DATA(^PSRX("AR",PSODATE,PSOIEN,PSOFILL))
SET RESULT=1
+8 QUIT RESULT
+9 ;
PARK(ORIEN) ; DETERMINES IF A PRESCRIPTION IS PARK
+1 ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
+2 ;
+3 IF $GET(ORIEN)=""
QUIT 0
+4 NEW PSOIEN
+5 SET PSOIEN=$ORDER(^PSRX("APL",ORIEN,""))
+6 IF +PSOIEN=0
QUIT 0
+7 IF $GET(^PSRX(PSOIEN,"STA"))'=0
QUIT 0
+8 NEW RESULT
SET RESULT=0
+9 IF $GET(^PSRX(PSOIEN,"PARK"))=1
SET RESULT=1
+10 QUIT RESULT
SUSP(ORIEN) ; DETERMINES IF A PRESCRIPTION IS SUSPENDED
+1 ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
+2 ;
+3 IF $GET(ORIEN)=""
QUIT 0
+4 NEW PSOIEN
+5 SET PSOIEN=$ORDER(^PSRX("APL",ORIEN,""))
+6 IF +PSOIEN=0
QUIT 0
+7 IF $GET(^PSRX(PSOIEN,"STA"))=5
QUIT 1
+8 QUIT 0
