Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSO5241

PSO5241.m

Go to the documentation of this file.
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