PSO525AP ;BHAM ISC/SAB- encap II API to return suspended Rx data ; 04/07/05 10:30 am
;;7.0;OUTPATIENT PHARMACY;**213,229**;DEC 1997
;
SUS(LIST,DFN,IEN,RX,SDATE,EDATE) ;
;
;LIST: Subscript name used in ^TMP global [REQUIRED]
;DFN: Patient's IEN
;IEN: Internal record number [optional]
;RX #: Pointer to Prescription file (#52) [optional]
;SDATE: Starting Suspense Date [optional]
;EDATE: Ending Suspense Date [optional]
;
Q:$G(LIST)=""
N DA,DR,PSOPOST,DIC,DIQ,ND,LK K ^TMP($J,LIST)
I $G(IEN) D G CLEAN
.I $G(^PS(52.5,IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND" Q
.D PROCESS
I $G(RX)]"",'$G(IEN) S IEN=$O(^PS(52.5,"B",RX,0)) D G CLEAN
.I 'IEN Q
.D PROCESS
I $G(SDATE)!($G(EDATE)) D DATE G CLEAN
I $G(DFN) F IEN=0:0 S IEN=$O(^PS(52.5,"AF",DFN,IEN)) Q:'IEN D
.I DFN'=$P($G(^PS(52.5,IEN,0)),"^",3) S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)" Q
.D PROCESS
I '$G(DFN) F DFN=0:0 S DFN=$O(^PS(52.5,"AF",DFN)) Q:'DFN F IEN=0:0 S IEN=$O(^PS(52.5,"AF",DFN,IEN)) Q:'IEN D PROCESS
CLEAN I $G(DFN),'$O(^TMP($J,LIST,DFN,0)) S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND"
I '$G(DFN),'$O(^TMP($J,LIST,0)) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
K DA,DR,DIC,PSOPOST,DIQ,LDATE
Q
PROCESS ;
I $G(^PS(52.5,IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND" Q
I $G(DFN),DFN'=$P($G(^PS(52.5,IEN,0)),"^",3) Q
K PSOPOST S DIC=52.5,DA=IEN,DR=".01;.02;.03;.05;2;3;9",DIQ="PSOPOST",DIQ(0)="IE" D EN^DIQ1
F DR=.01,.02,.03,.05,2,3,9 D
.I DR=.01 S ^TMP($J,LIST,"B",PSOPOST(52.5,DA,DR,"I"),IEN)=""
.I DR=.03 S ^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),0)=$G(^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),0))+1
.I PSOPOST(52.5,DA,DR,"E")'=PSOPOST(52.5,DA,DR,"I") S ^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")_"^"_PSOPOST(52.5,DA,DR,"E") Q
.S ^TMP($J,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")
K DA,DR,PSOPOST,DIC,DIQ
Q
DATE ;date range
I $G(SDATE) S LDATE=SDATE-1 D Q
.I $G(EDATE) F S LDATE=$O(^PS(52.5,"C",LDATE)) Q:'LDATE!(LDATE>EDATE) F IEN=0:0 S IEN=$O(^PS(52.5,"C",LDATE,IEN)) Q:'IEN D PROCESS
.I '$G(EDATE) F S LDATE=$O(^PS(52.5,"C",LDATE)) Q:'LDATE F IEN=0:0 S IEN=$O(^PS(52.5,"C",LDATE,IEN)) Q:'IEN D PROCESS
I $G(EDATE) S LDATE=0 F S LDATE=$O(^PS(52.5,"C",LDATE)) Q:'LDATE!(LDATE>EDATE) F IEN=0:0 S IEN=$O(^PS(52.5,"C",LDATE,IEN)) Q:'IEN D PROCESS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO525AP 2380 printed Sep 23, 2025@19:59:13 Page 2
PSO525AP ;BHAM ISC/SAB- encap II API to return suspended Rx data ; 04/07/05 10:30 am
+1 ;;7.0;OUTPATIENT PHARMACY;**213,229**;DEC 1997
+2 ;
SUS(LIST,DFN,IEN,RX,SDATE,EDATE) ;
+1 ;
+2 ;LIST: Subscript name used in ^TMP global [REQUIRED]
+3 ;DFN: Patient's IEN
+4 ;IEN: Internal record number [optional]
+5 ;RX #: Pointer to Prescription file (#52) [optional]
+6 ;SDATE: Starting Suspense Date [optional]
+7 ;EDATE: Ending Suspense Date [optional]
+8 ;
+9 if $GET(LIST)=""
QUIT
+10 NEW DA,DR,PSOPOST,DIC,DIQ,ND,LK
KILL ^TMP($JOB,LIST)
+11 IF $GET(IEN)
Begin DoDot:1
+12 IF $GET(^PS(52.5,IEN,0))']""
SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND"
QUIT
+13 DO PROCESS
End DoDot:1
GOTO CLEAN
+14 IF $GET(RX)]""
IF '$GET(IEN)
SET IEN=$ORDER(^PS(52.5,"B",RX,0))
Begin DoDot:1
+15 IF 'IEN
QUIT
+16 DO PROCESS
End DoDot:1
GOTO CLEAN
+17 IF $GET(SDATE)!($GET(EDATE))
DO DATE
GOTO CLEAN
+18 IF $GET(DFN)
FOR IEN=0:0
SET IEN=$ORDER(^PS(52.5,"AF",DFN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+19 IF DFN'=$PIECE($GET(^PS(52.5,IEN,0)),"^",3)
SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)"
QUIT
+20 DO PROCESS
End DoDot:1
+21 IF '$GET(DFN)
FOR DFN=0:0
SET DFN=$ORDER(^PS(52.5,"AF",DFN))
if 'DFN
QUIT
FOR IEN=0:0
SET IEN=$ORDER(^PS(52.5,"AF",DFN,IEN))
if 'IEN
QUIT
DO PROCESS
CLEAN IF $GET(DFN)
IF '$ORDER(^TMP($JOB,LIST,DFN,0))
SET ^TMP($JOB,LIST,DFN,0)="-1^NO DATA FOUND"
+1 IF '$GET(DFN)
IF '$ORDER(^TMP($JOB,LIST,0))
SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
+2 KILL DA,DR,DIC,PSOPOST,DIQ,LDATE
+3 QUIT
PROCESS ;
+1 IF $GET(^PS(52.5,IEN,0))']""
SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND"
QUIT
+2 IF $GET(DFN)
IF DFN'=$PIECE($GET(^PS(52.5,IEN,0)),"^",3)
QUIT
+3 KILL PSOPOST
SET DIC=52.5
SET DA=IEN
SET DR=".01;.02;.03;.05;2;3;9"
SET DIQ="PSOPOST"
SET DIQ(0)="IE"
DO EN^DIQ1
+4 FOR DR=.01,.02,.03,.05,2,3,9
Begin DoDot:1
+5 IF DR=.01
SET ^TMP($JOB,LIST,"B",PSOPOST(52.5,DA,DR,"I"),IEN)=""
+6 IF DR=.03
SET ^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),0)=$GET(^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),0))+1
+7 IF PSOPOST(52.5,DA,DR,"E")'=PSOPOST(52.5,DA,DR,"I")
SET ^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")_"^"_PSOPOST(52.5,DA,DR,"E")
QUIT
+8 SET ^TMP($JOB,LIST,PSOPOST(52.5,DA,.03,"I"),IEN,DR)=PSOPOST(52.5,DA,DR,"I")
End DoDot:1
+9 KILL DA,DR,PSOPOST,DIC,DIQ
+10 QUIT
DATE ;date range
+1 IF $GET(SDATE)
SET LDATE=SDATE-1
Begin DoDot:1
+2 IF $GET(EDATE)
FOR
SET LDATE=$ORDER(^PS(52.5,"C",LDATE))
if 'LDATE!(LDATE>EDATE)
QUIT
FOR IEN=0:0
SET IEN=$ORDER(^PS(52.5,"C",LDATE,IEN))
if 'IEN
QUIT
DO PROCESS
+3 IF '$GET(EDATE)
FOR
SET LDATE=$ORDER(^PS(52.5,"C",LDATE))
if 'LDATE
QUIT
FOR IEN=0:0
SET IEN=$ORDER(^PS(52.5,"C",LDATE,IEN))
if 'IEN
QUIT
DO PROCESS
End DoDot:1
QUIT
+4 IF $GET(EDATE)
SET LDATE=0
FOR
SET LDATE=$ORDER(^PS(52.5,"C",LDATE))
if 'LDATE!(LDATE>EDATE)
QUIT
FOR IEN=0:0
SET IEN=$ORDER(^PS(52.5,"C",LDATE,IEN))
if 'IEN
QUIT
DO PROCESS
+5 QUIT
