PSO52B ;BHAM ISC/AGV - Encap II API to return Rx data ;07/18/06 10:30 am
;;7.0;OUTPATIENT PHARMACY;**252,566**;DEC 1997;Build 5
;
;Reference to ^PS(50.7 supported by DBIA 2223
;
;Rx profile called from RX^PSO52API
;
PT ;par
I '$O(^PSRX(IEN,"P",0)) S ^TMP($J,LIST,DFN,IEN,"P",0)="-1^NO DATA FOUND" Q
N PT F PT=0:0 S PT=$O(^PSRX(IEN,"P",PT)) Q:'PT S DA(52.2)=PT D PTP
K DA,DR,PST,DIC,DIQ,PT
Q
PTP ;
S ^TMP($J,LIST,DFN,IEN,"P",0)=$G(^TMP($J,LIST,DFN,IEN,"P",0))+1
K PST S DR(52.2)=".01:8",DIC=52,DA=IEN,DR=60 D DIQ^PSO52API
F DR=.01,.02,.03,.04,.05,.06,.08,.09,.041,.042,1,5,6,7.5,8 D
.I PST(52.2,DA(52.2),DR,"E")'=PST(52.2,DA(52.2),DR,"I") S ^TMP($J,LIST,DFN,IEN,"P",DA(52.2),DR)=PST(52.2,DA(52.2),DR,"I")_"^"_PST(52.2,DA(52.2),DR,"E") Q
.S ^TMP($J,LIST,DFN,IEN,"P",DA(52.2),DR)=PST(52.2,DA(52.2),DR,"I")
Q
SD ;sand
K PST S DIC=52,DA=IEN,DR="301;302;303" D DIQ^PSO52API F DR=301,302,303 D
.I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
.S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
K DA,DR,PST,DIC,DIQ
Q
TB ;tpb
K PST S DIC=52,DA=IEN,DR=201 D DIQ^PSO52API
I $G(PST(52,DA,DR,"E"))']"" S ^TMP($J,LIST,DFN,DA,DR)="" Q
S ^TMP($J,LIST,DFN,DA,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E")
K DA,DR,PST,DIC,DIQ
Q
OI ;orderable item
K PST S DIC=52,DA=IEN,DR=39.2 D DIQ^PSO52API
I $G(PST(52,DA,DR,"I"))']"" S ^TMP($J,LIST,DFN,DA,"OI")="-1^NO DATA FOUND" Q
S ^TMP($J,LIST,DFN,DA,"OI")=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E")
S DIC=50.7,DA=PST(52,DA,DR,"I"),DR=.02,DIQ(0)="IE" D DIQ^PSO52API
S ^TMP($J,LIST,DFN,IEN,"OI")=^TMP($J,LIST,DFN,IEN,"OI")_"^"_PST(50.7,DA,DR,"I")_"^"_PST(50.7,DA,DR,"E")
K DA,DR,PST,DIC,DIQ
Q
MLT ;ICD multiple
I '$O(^PSRX(IEN,"ICD",0)) S ^TMP($J,LIST,DFN,IEN,"ICD",0)="-1^NO DATA FOUND" Q
N MT F MT=0:0 S MT=$O(^PSRX(IEN,"ICD",MT)) Q:'MT S DA(52.052311)=MT D MULT
K DA,DR,PST,DIC,DIQ,MT
Q
;
MULT ;
S ^TMP($J,LIST,DFN,IEN,"ICD",0)=$G(^TMP($J,LIST,DFN,IEN,"ICD",0))+1
K PST S DR(52.052311)=".01:7" S DIC=52,DA=IEN,DR=52311 D DIQ^PSO52API
F DR=.01,1,2,3,4,5,6,7 D
.I PST(52.052311,DA(52.052311),DR,"E")'=PST(52.052311,DA(52.052311),DR,"I") S ^TMP($J,LIST,DFN,IEN,"ICD",DA(52.052311),DR)=PST(52.052311,DA(52.052311),DR,"I")_"^"_PST(52.052311,DA(52.052311),DR,"E") Q
.S ^TMP($J,LIST,DFN,IEN,"ICD",DA(52.052311),DR)=PST(52.052311,DA(52.052311),DR,"I")
K DA,DR,PST,DIC,DIQ
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO52B 2442 printed Sep 23, 2025@19:59:18 Page 2
PSO52B ;BHAM ISC/AGV - Encap II API to return Rx data ;07/18/06 10:30 am
+1 ;;7.0;OUTPATIENT PHARMACY;**252,566**;DEC 1997;Build 5
+2 ;
+3 ;Reference to ^PS(50.7 supported by DBIA 2223
+4 ;
+5 ;Rx profile called from RX^PSO52API
+6 ;
PT ;par
+1 IF '$ORDER(^PSRX(IEN,"P",0))
SET ^TMP($JOB,LIST,DFN,IEN,"P",0)="-1^NO DATA FOUND"
QUIT
+2 NEW PT
FOR PT=0:0
SET PT=$ORDER(^PSRX(IEN,"P",PT))
if 'PT
QUIT
SET DA(52.2)=PT
DO PTP
+3 KILL DA,DR,PST,DIC,DIQ,PT
+4 QUIT
PTP ;
+1 SET ^TMP($JOB,LIST,DFN,IEN,"P",0)=$GET(^TMP($JOB,LIST,DFN,IEN,"P",0))+1
+2 KILL PST
SET DR(52.2)=".01:8"
SET DIC=52
SET DA=IEN
SET DR=60
DO DIQ^PSO52API
+3 FOR DR=.01,.02,.03,.04,.05,.06,.08,.09,.041,.042,1,5,6,7.5,8
Begin DoDot:1
+4 IF PST(52.2,DA(52.2),DR,"E")'=PST(52.2,DA(52.2),DR,"I")
SET ^TMP($JOB,LIST,DFN,IEN,"P",DA(52.2),DR)=PST(52.2,DA(52.2),DR,"I")_"^"_PST(52.2,DA(52.2),DR,"E")
QUIT
+5 SET ^TMP($JOB,LIST,DFN,IEN,"P",DA(52.2),DR)=PST(52.2,DA(52.2),DR,"I")
End DoDot:1
+6 QUIT
SD ;sand
+1 KILL PST
SET DIC=52
SET DA=IEN
SET DR="301;302;303"
DO DIQ^PSO52API
FOR DR=301,302,303
Begin DoDot:1
+2 IF PST(52,DA,DR,"E")'=PST(52,DA,DR,"I")
SET ^TMP($JOB,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E")
QUIT
+3 SET ^TMP($JOB,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
End DoDot:1
+4 KILL DA,DR,PST,DIC,DIQ
+5 QUIT
TB ;tpb
+1 KILL PST
SET DIC=52
SET DA=IEN
SET DR=201
DO DIQ^PSO52API
+2 IF $GET(PST(52,DA,DR,"E"))']""
SET ^TMP($JOB,LIST,DFN,DA,DR)=""
QUIT
+3 SET ^TMP($JOB,LIST,DFN,DA,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E")
+4 KILL DA,DR,PST,DIC,DIQ
+5 QUIT
OI ;orderable item
+1 KILL PST
SET DIC=52
SET DA=IEN
SET DR=39.2
DO DIQ^PSO52API
+2 IF $GET(PST(52,DA,DR,"I"))']""
SET ^TMP($JOB,LIST,DFN,DA,"OI")="-1^NO DATA FOUND"
QUIT
+3 SET ^TMP($JOB,LIST,DFN,DA,"OI")=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E")
+4 SET DIC=50.7
SET DA=PST(52,DA,DR,"I")
SET DR=.02
SET DIQ(0)="IE"
DO DIQ^PSO52API
+5 SET ^TMP($JOB,LIST,DFN,IEN,"OI")=^TMP($JOB,LIST,DFN,IEN,"OI")_"^"_PST(50.7,DA,DR,"I")_"^"_PST(50.7,DA,DR,"E")
+6 KILL DA,DR,PST,DIC,DIQ
+7 QUIT
MLT ;ICD multiple
+1 IF '$ORDER(^PSRX(IEN,"ICD",0))
SET ^TMP($JOB,LIST,DFN,IEN,"ICD",0)="-1^NO DATA FOUND"
QUIT
+2 NEW MT
FOR MT=0:0
SET MT=$ORDER(^PSRX(IEN,"ICD",MT))
if 'MT
QUIT
SET DA(52.052311)=MT
DO MULT
+3 KILL DA,DR,PST,DIC,DIQ,MT
+4 QUIT
+5 ;
MULT ;
+1 SET ^TMP($JOB,LIST,DFN,IEN,"ICD",0)=$GET(^TMP($JOB,LIST,DFN,IEN,"ICD",0))+1
+2 KILL PST
SET DR(52.052311)=".01:7"
SET DIC=52
SET DA=IEN
SET DR=52311
DO DIQ^PSO52API
+3 FOR DR=.01,1,2,3,4,5,6,7
Begin DoDot:1
+4 IF PST(52.052311,DA(52.052311),DR,"E")'=PST(52.052311,DA(52.052311),DR,"I")
SET ^TMP($JOB,LIST,DFN,IEN,"ICD",DA(52.052311),DR)=PST(52.052311,DA(52.052311),DR,"I")_"^"_PST(52.052311,DA(52.052311),DR,"E")
QUIT
+5 SET ^TMP($JOB,LIST,DFN,IEN,"ICD",DA(52.052311),DR)=PST(52.052311,DA(52.052311),DR,"I")
End DoDot:1
+6 KILL DA,DR,PST,DIC,DIQ
+7 QUIT
