PSO5241 ;BHAM ISC/SAB - encap II API to return pending Rx data ;May 15, 2018@09:04
;;7.0;OUTPATIENT PHARMACY;**213,314,566**;DEC 1997;Build 5
;^PSDRUG supported by DBIA 221
;^PS(50.7 supported by DBIA 2223
;^PS(55 supported by DBIA 2228
;
PEN(DFN,LIST,IEN,PLACER) ;
;
;DFN: Patient's IEN
;LIST: Subscript name used in ^TMP global [REQUIRED]
;IEN: Internal record number [optional]
;PLACER: Pointer to Orders file (#100) [optional]
;
Q:$G(DFN)']"" Q:$G(LIST)=""
N DA,DR,PSOPOST,DIC,DIQ,ND,LK,PSOPDIEN,PSOPDDAT,PSOPDERR,PSOPDL K ^TMP($J,LIST)
S ^TMP($J,LIST,DFN,0)=0
I $G(IEN) D PROCESS G CLEAN
I $G(PLACER)]"",'$G(IEN) S IEN=$O(^PS(52.41,"B",PLACER,0)) D G CLEAN
.I 'IEN S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND" Q
.D PROCESS
F IEN=0:0 S IEN=$O(^PS(52.41,"P",DFN,IEN)) Q:'IEN D PROCESS
CLEAN I ^TMP($J,LIST,DFN,0)=0 S ^TMP($J,LIST,DFN,0)="-1^NO DATA FOUND"
K DA,DR,DIC,PSOPOST,DIQ
Q
PROCESS ;
Q:$P($G(^PS(52.41,IEN,0)),"^",3)="DC" Q:$P($G(^PS(52.41,IEN,0)),"^",3)="DE"
I DFN'=$P($G(^PS(52.41,IEN,0)),"^",2) S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)" Q
I $G(^PS(52.41,IEN,0))']"" S ^TMP($J,LIST,DFN,IEN,0)="-1^NO DATA FOUND" Q
K PSOPOST S DIC=52.41,DA=IEN,DR=".01;1;1.1;2;5;6;8;9;11;12;13;15;19;21;22.1;26;100;101",DIQ="PSOPOST",DIQ(0)="IE" D EN^DIQ1
F DR=.01,1,1.1,2,5,6,12,13,15,19,21,22.1,26,100,101,8 D I DR=8 D OI
.I DR=.01 S ^TMP($J,LIST,DFN,"B",PSOPOST(52.41,DA,DR,"I"),IEN)=""
.I PSOPOST(52.41,DA,DR,"E")'=PSOPOST(52.41,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")_"^"_PSOPOST(52.41,DA,DR,"E") Q
.S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")
.I DR=22.1,^TMP($J,LIST,DFN,IEN,DR)]"" D
..S IEN52=^TMP($J,LIST,DFN,IEN,DR)
..S $P(^TMP($J,LIST,DFN,IEN,DR),"^",2)=$$GET1^DIQ(52,IEN52,.01)
S DR=11 D
.I PSOPOST(52.41,IEN,DR,"E")'=PSOPOST(52.41,IEN,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")_"^"_PSOPOST(52.41,IEN,DR,"E") Q
.S ^TMP($J,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")
S ^TMP($J,LIST,DFN,0)=^TMP($J,LIST,DFN,0)+1
K PSOPDDAT,PSOPDERR S PSOPDIEN=IEN_"," D GETS^DIQ(52.41,PSOPDIEN,"24*","I","PSOPDDAT","PSOPDERR") D
.I $D(PSOPDERR) S ^TMP($J,LIST,DFN,IEN,24)="" Q
.S PSOPDL="" F S PSOPDL=$O(PSOPDDAT(52.4124,PSOPDL)) Q:PSOPDL="" D
..S ^TMP($J,LIST,DFN,IEN,24,+PSOPDL)=PSOPDDAT(52.4124,PSOPDL,.01,"I")
K DA,DR,PSOPOST,DIC,DIQ,IEN52
Q
OI ;orderable item
S DIC=50.7,DA=PSOPOST(52.41,DA,DR,"I"),DR=.02,DIQ(0)="IE" D EN^DIQ1
S ^TMP($J,LIST,DFN,IEN,8)=^TMP($J,LIST,DFN,IEN,8)_"^"_PSOPOST(50.7,DA,DR,"I")_"^"_PSOPOST(50.7,DA,DR,"E")
Q
;
;
NONVA(PSODFN,PSOLST,PSOSIEN,PSOPL) ;
;PSODFN: Patient's IEN [required]
;PSOLST: Subscript name used in ^TMP global [required]
;PSOSIEN: Sub-internal record number [optional]
;PSOPL: Pointer to Orders file (#100) [optional]
;
I $G(PSODFN)=""!($G(PSOLST)="") Q
N PSOCTR,PSODATA,PSOERROR,PSOIENS,PSOFLD,PSOOI,PSOOINS,PSOLOOP,PSOLOOPC K ^TMP($J,PSOLST)
S PSOCTR=0
I $G(PSOSIEN) D GET G END
I $G(PSOPL)'="" S PSOSIEN=0 D G END
.F PSOLOOP=0:0 S PSOLOOP=$O(^PS(55,PSODFN,"NVA",PSOLOOP)) Q:'PSOLOOP!PSOSIEN I PSOPL=$P($G(^PS(55,PSODFN,"NVA",PSOLOOP,0)),"^",8) S PSOSIEN=PSOLOOP
.I 'PSOSIEN Q
.D GET
F PSOSIEN=0:0 S PSOSIEN=$O(^PS(55,PSODFN,"NVA",PSOSIEN)) Q:'PSOSIEN D GET
END ;
I 'PSOCTR S ^TMP($J,PSOLST,PSODFN,0)="-1^NO DATA FOUND" Q
S ^TMP($J,PSOLST,PSODFN,0)=PSOCTR
Q
;
GET ;
I $G(^PS(55,PSODFN,"NVA",PSOSIEN,0))="" Q
K PSODATA,PSOERROR
S PSOIENS=PSOSIEN_","_PSODFN_","
D GETS^DIQ(55.05,PSOIENS,".01:8;10:14","IE","PSODATA","PSOERROR")
S PSOOI=PSODATA(55.05,PSOIENS,.01,"I")
I $D(PSOERROR)!('$G(PSOOI)) Q
S ^TMP($J,PSOLST,PSODFN,"B",PSOOI,PSOSIEN)=""
S ^TMP($J,PSOLST,PSODFN,+PSOIENS,.01)=PSODATA(55.05,PSOIENS,.01,"I")_"^"_PSODATA(55.05,PSOIENS,.01,"E")
F PSOFLD=1,2,3,4,5,6,7,8,11,12,13 D
.I PSODATA(55.05,PSOIENS,PSOFLD,"E")'=PSODATA(55.05,PSOIENS,PSOFLD,"I") S ^TMP($J,PSOLST,PSODFN,+PSOIENS,PSOFLD)=PSODATA(55.05,PSOIENS,PSOFLD,"I")_"^"_PSODATA(55.05,PSOIENS,PSOFLD,"E") Q
.S ^TMP($J,PSOLST,PSODFN,+PSOIENS,PSOFLD)=PSODATA(55.05,PSOIENS,PSOFLD,"I")
D COMM
D DSCLM
K PSODATA,PSOERROR S PSOOINS=PSOOI_","
D GETS^DIQ(50.7,PSOOINS,".02","IE","PSODATA","PSOERROR")
I '$D(PSOERROR),$G(PSODATA(50.7,PSOOINS,.02,"I")) D
.S ^TMP($J,PSOLST,PSODFN,+PSOIENS,.01)=^TMP($J,PSOLST,PSODFN,+PSOIENS,.01)_"^"_PSODATA(50.7,PSOOINS,.02,"I")_"^"_PSODATA(50.7,PSOOINS,.02,"E")
S PSOCTR=PSOCTR+1
Q
;
COMM ;Comments
I '$O(PSODATA(55.05,PSOIENS,14,0)) S ^TMP($J,PSOLST,PSODFN,+PSOIENS,14)="" Q
K PSODATA(55.05,PSOIENS,14,"E"),PSODATA(55.05,PSOIENS,14,"I")
M ^TMP($J,PSOLST,PSODFN,+PSOIENS,14)=PSODATA(55.05,PSOIENS,14)
Q
;
DSCLM ;Disclaimer
I '$O(PSODATA(55.05,PSOIENS,10,0)) S ^TMP($J,PSOLST,PSODFN,+PSOIENS,10)="" Q
K PSODATA(55.05,PSOIENS,10,"E"),PSODATA(55.05,PSOIENS,10,"I")
M ^TMP($J,PSOLST,PSODFN,+PSOIENS,10)=PSODATA(55.05,PSOIENS,10)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO5241 4926 printed Nov 22, 2024@17:33:03 Page 2
PSO5241 ;BHAM ISC/SAB - encap II API to return pending Rx data ;May 15, 2018@09:04
+1 ;;7.0;OUTPATIENT PHARMACY;**213,314,566**;DEC 1997;Build 5
+2 ;^PSDRUG supported by DBIA 221
+3 ;^PS(50.7 supported by DBIA 2223
+4 ;^PS(55 supported by DBIA 2228
+5 ;
PEN(DFN,LIST,IEN,PLACER) ;
+1 ;
+2 ;DFN: Patient's IEN
+3 ;LIST: Subscript name used in ^TMP global [REQUIRED]
+4 ;IEN: Internal record number [optional]
+5 ;PLACER: Pointer to Orders file (#100) [optional]
+6 ;
+7 if $GET(DFN)']""
QUIT
if $GET(LIST)=""
QUIT
+8 NEW DA,DR,PSOPOST,DIC,DIQ,ND,LK,PSOPDIEN,PSOPDDAT,PSOPDERR,PSOPDL
KILL ^TMP($JOB,LIST)
+9 SET ^TMP($JOB,LIST,DFN,0)=0
+10 IF $GET(IEN)
DO PROCESS
GOTO CLEAN
+11 IF $GET(PLACER)]""
IF '$GET(IEN)
SET IEN=$ORDER(^PS(52.41,"B",PLACER,0))
Begin DoDot:1
+12 IF 'IEN
SET ^TMP($JOB,LIST,DFN,0)="-1^NO DATA FOUND"
QUIT
+13 DO PROCESS
End DoDot:1
GOTO CLEAN
+14 FOR IEN=0:0
SET IEN=$ORDER(^PS(52.41,"P",DFN,IEN))
if 'IEN
QUIT
DO PROCESS
CLEAN IF ^TMP($JOB,LIST,DFN,0)=0
SET ^TMP($JOB,LIST,DFN,0)="-1^NO DATA FOUND"
+1 KILL DA,DR,DIC,PSOPOST,DIQ
+2 QUIT
PROCESS ;
+1 if $PIECE($GET(^PS(52.41,IEN,0)),"^",3)="DC"
QUIT
if $PIECE($GET(^PS(52.41,IEN,0)),"^",3)="DE"
QUIT
+2 IF DFN'=$PIECE($GET(^PS(52.41,IEN,0)),"^",2)
SET ^TMP($JOB,LIST,IEN,0)="-1^NO DATA FOUND (MISMATCHED PATIENT)"
QUIT
+3 IF $GET(^PS(52.41,IEN,0))']""
SET ^TMP($JOB,LIST,DFN,IEN,0)="-1^NO DATA FOUND"
QUIT
+4 KILL PSOPOST
SET DIC=52.41
SET DA=IEN
SET DR=".01;1;1.1;2;5;6;8;9;11;12;13;15;19;21;22.1;26;100;101"
SET DIQ="PSOPOST"
SET DIQ(0)="IE"
DO EN^DIQ1
+5 FOR DR=.01,1,1.1,2,5,6,12,13,15,19,21,22.1,26,100,101,8
Begin DoDot:1
+6 IF DR=.01
SET ^TMP($JOB,LIST,DFN,"B",PSOPOST(52.41,DA,DR,"I"),IEN)=""
+7 IF PSOPOST(52.41,DA,DR,"E")'=PSOPOST(52.41,DA,DR,"I")
SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")_"^"_PSOPOST(52.41,DA,DR,"E")
QUIT
+8 SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,DA,DR,"I")
+9 IF DR=22.1
IF ^TMP($JOB,LIST,DFN,IEN,DR)]""
Begin DoDot:2
+10 SET IEN52=^TMP($JOB,LIST,DFN,IEN,DR)
+11 SET $PIECE(^TMP($JOB,LIST,DFN,IEN,DR),"^",2)=$$GET1^DIQ(52,IEN52,.01)
End DoDot:2
End DoDot:1
IF DR=8
DO OI
+12 SET DR=11
Begin DoDot:1
+13 IF PSOPOST(52.41,IEN,DR,"E")'=PSOPOST(52.41,IEN,DR,"I")
SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")_"^"_PSOPOST(52.41,IEN,DR,"E")
QUIT
+14 SET ^TMP($JOB,LIST,DFN,IEN,DR)=PSOPOST(52.41,IEN,DR,"I")
End DoDot:1
+15 SET ^TMP($JOB,LIST,DFN,0)=^TMP($JOB,LIST,DFN,0)+1
+16 KILL PSOPDDAT,PSOPDERR
SET PSOPDIEN=IEN_","
DO GETS^DIQ(52.41,PSOPDIEN,"24*","I","PSOPDDAT","PSOPDERR")
Begin DoDot:1
+17 IF $DATA(PSOPDERR)
SET ^TMP($JOB,LIST,DFN,IEN,24)=""
QUIT
+18 SET PSOPDL=""
FOR
SET PSOPDL=$ORDER(PSOPDDAT(52.4124,PSOPDL))
if PSOPDL=""
QUIT
Begin DoDot:2
+19 SET ^TMP($JOB,LIST,DFN,IEN,24,+PSOPDL)=PSOPDDAT(52.4124,PSOPDL,.01,"I")
End DoDot:2
End DoDot:1
+20 KILL DA,DR,PSOPOST,DIC,DIQ,IEN52
+21 QUIT
OI ;orderable item
+1 SET DIC=50.7
SET DA=PSOPOST(52.41,DA,DR,"I")
SET DR=.02
SET DIQ(0)="IE"
DO EN^DIQ1
+2 SET ^TMP($JOB,LIST,DFN,IEN,8)=^TMP($JOB,LIST,DFN,IEN,8)_"^"_PSOPOST(50.7,DA,DR,"I")_"^"_PSOPOST(50.7,DA,DR,"E")
+3 QUIT
+4 ;
+5 ;
NONVA(PSODFN,PSOLST,PSOSIEN,PSOPL) ;
+1 ;PSODFN: Patient's IEN [required]
+2 ;PSOLST: Subscript name used in ^TMP global [required]
+3 ;PSOSIEN: Sub-internal record number [optional]
+4 ;PSOPL: Pointer to Orders file (#100) [optional]
+5 ;
+6 IF $GET(PSODFN)=""!($GET(PSOLST)="")
QUIT
+7 NEW PSOCTR,PSODATA,PSOERROR,PSOIENS,PSOFLD,PSOOI,PSOOINS,PSOLOOP,PSOLOOPC
KILL ^TMP($JOB,PSOLST)
+8 SET PSOCTR=0
+9 IF $GET(PSOSIEN)
DO GET
GOTO END
+10 IF $GET(PSOPL)'=""
SET PSOSIEN=0
Begin DoDot:1
+11 FOR PSOLOOP=0:0
SET PSOLOOP=$ORDER(^PS(55,PSODFN,"NVA",PSOLOOP))
if 'PSOLOOP!PSOSIEN
QUIT
IF PSOPL=$PIECE($GET(^PS(55,PSODFN,"NVA",PSOLOOP,0)),"^",8)
SET PSOSIEN=PSOLOOP
+12 IF 'PSOSIEN
QUIT
+13 DO GET
End DoDot:1
GOTO END
+14 FOR PSOSIEN=0:0
SET PSOSIEN=$ORDER(^PS(55,PSODFN,"NVA",PSOSIEN))
if 'PSOSIEN
QUIT
DO GET
END ;
+1 IF 'PSOCTR
SET ^TMP($JOB,PSOLST,PSODFN,0)="-1^NO DATA FOUND"
QUIT
+2 SET ^TMP($JOB,PSOLST,PSODFN,0)=PSOCTR
+3 QUIT
+4 ;
GET ;
+1 IF $GET(^PS(55,PSODFN,"NVA",PSOSIEN,0))=""
QUIT
+2 KILL PSODATA,PSOERROR
+3 SET PSOIENS=PSOSIEN_","_PSODFN_","
+4 DO GETS^DIQ(55.05,PSOIENS,".01:8;10:14","IE","PSODATA","PSOERROR")
+5 SET PSOOI=PSODATA(55.05,PSOIENS,.01,"I")
+6 IF $DATA(PSOERROR)!('$GET(PSOOI))
QUIT
+7 SET ^TMP($JOB,PSOLST,PSODFN,"B",PSOOI,PSOSIEN)=""
+8 SET ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,.01)=PSODATA(55.05,PSOIENS,.01,"I")_"^"_PSODATA(55.05,PSOIENS,.01,"E")
+9 FOR PSOFLD=1,2,3,4,5,6,7,8,11,12,13
Begin DoDot:1
+10 IF PSODATA(55.05,PSOIENS,PSOFLD,"E")'=PSODATA(55.05,PSOIENS,PSOFLD,"I")
SET ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,PSOFLD)=PSODATA(55.05,PSOIENS,PSOFLD,"I")_"^"_PSODATA(55.05,PSOIENS,PSOFLD,"E")
QUIT
+11 SET ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,PSOFLD)=PSODATA(55.05,PSOIENS,PSOFLD,"I")
End DoDot:1
+12 DO COMM
+13 DO DSCLM
+14 KILL PSODATA,PSOERROR
SET PSOOINS=PSOOI_","
+15 DO GETS^DIQ(50.7,PSOOINS,".02","IE","PSODATA","PSOERROR")
+16 IF '$DATA(PSOERROR)
IF $GET(PSODATA(50.7,PSOOINS,.02,"I"))
Begin DoDot:1
+17 SET ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,.01)=^TMP($JOB,PSOLST,PSODFN,+PSOIENS,.01)_"^"_PSODATA(50.7,PSOOINS,.02,"I")_"^"_PSODATA(50.7,PSOOINS,.02,"E")
End DoDot:1
+18 SET PSOCTR=PSOCTR+1
+19 QUIT
+20 ;
COMM ;Comments
+1 IF '$ORDER(PSODATA(55.05,PSOIENS,14,0))
SET ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,14)=""
QUIT
+2 KILL PSODATA(55.05,PSOIENS,14,"E"),PSODATA(55.05,PSOIENS,14,"I")
+3 MERGE ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,14)=PSODATA(55.05,PSOIENS,14)
+4 QUIT
+5 ;
DSCLM ;Disclaimer
+1 IF '$ORDER(PSODATA(55.05,PSOIENS,10,0))
SET ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,10)=""
QUIT
+2 KILL PSODATA(55.05,PSOIENS,10,"E"),PSODATA(55.05,PSOIENS,10,"I")
+3 MERGE ^TMP($JOB,PSOLST,PSODFN,+PSOIENS,10)=PSODATA(55.05,PSOIENS,10)
+4 QUIT
