PSS551 ;BHM/DB - API FOR PHARMACY PATIENT FILE ;15 JUN 05
;;1.0;PHARMACY DATA MANAGEMENT;**108,118,133,169,173**;9/30/97;Build 9
;DFN: IEN of Patient [REQUIRED]
;PO: Order # [optional]
;PSDATE: Start Date [optional]
;PEDATE: End Date [optional]
;If a start date is sent, an end date must also be sent
;LIST: Subscript name used in ^TMP global [REQUIRED]
N PSSPO,PSSIEN,DA,DR,DIC,PSS,CNT1,X,PSSTMP
I $G(LIST)="" Q
K ^TMP($J,LIST)
I $G(DFN)="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
S PSSIEN=$G(DFN),PSSPO=$G(PO) S ^TMP($J,LIST,0)=0
I $G(PSSPO)>0,$G(PSSIEN)>0 S DA=PSSIEN,(IEN,DA(55.06))=PSSPO G DIQ431
I $G(PSSPO)="",$G(PSDATE)'="",$G(PEDATE)'="" S PSDATE=$S('$P(PSDATE,".",2):PSDATE_.000001,1:PSDATE),PEDATE=$S('$P($G(PEDATE),".",2):PEDATE_.999999,1:$G(PEDATE)) N PSS56 G DT431
I $G(PSSPO)="" N PSSPO1 G LOOP431
Q
LOOP431 S (PSSPO1,PSSPO)=0 F S PSSPO1=$O(^PS(55,DFN,5,"B",PSSPO1)) Q:PSSPO1'>0 F S PSSPO=$O(^PS(55,DFN,5,"B",PSSPO1,PSSPO)) Q:PSSPO'>0 S PO=PSSPO D DIQ431
Q
DIQ431 ;
I '$D(^PS(55,DFN,5,PO,0)) Q
S PSSIEN=PO_","_DFN_"," K DIQ
D GETS^DIQ(55.06,PSSIEN,".01;.5;1;2*;3;4;5;6;7;10;11;12;26;27;27.1;28;34;66;109","IE","^TMP(""PSS5506"",$J)")
F X=.01,.5,1,3,4,5,6,7,10,11,12,26,27,27.1,28,34,66,109 S ^TMP($J,LIST,+PSSPO,X)=$G(^TMP("PSS5506",$J,55.06,PSSIEN,X,"I"))
F X=.5,1,3,4,5,6,7,10,27,27.1,28,34 S ^TMP($J,LIST,+PSSPO,X)=$S($G(^TMP("PSS5506",$J,55.06,PSSIEN,X,"E"))'="":^TMP($J,LIST,+PSSPO,X)_"^"_$G(^TMP("PSS5506",$J,55.06,PSSIEN,X,"E")),1:"")
S PSSTMP=$P($G(^PS(55,DFN,5,PO,.2)),U) S ^TMP($J,LIST,IEN,108)=$S($G(PSSTMP)="":"",1:$$ORDITEM^PSS55(+PSSTMP))
S (PSS(1),CNT1)=0 F S PSS(1)=$O(^TMP("PSS5506",$J,55.07,PSS(1))) Q:'PSS(1) D
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.11)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.11,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.12)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.12,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.01)=$S($G(^TMP("PSS5506",$J,55.07,PSS(1),.01,"E"))'="":$G(^TMP("PSS5506",$J,55.07,PSS(1),.01,"I"))_"^"_$G(^TMP("PSS5506",$J,55.07,PSS(1),.01,"E")),1:"")
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.02)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.02,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.03)=$S($G(^TMP("PSS5506",$J,55.07,PSS(1),.03,"E"))'="":$G(^TMP("PSS5506",$J,55.07,PSS(1),.03,"I"))_"^"_$G(^TMP("PSS5506",$J,55.07,PSS(1),.03,"E")),1:"")
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.04)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.04,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.05)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.05,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.06)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.06,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.07)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.07,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.08)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.08,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.09)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.09,"I"))
.S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.1)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.1,"I"))
.S CNT1=CNT1+1
K ^TMP("PSS5506",$J),PSS(1) S ^TMP($J,LIST,"B",+PSSPO)=""
S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1
S ^TMP($J,LIST,+PSSPO,"DDRUG",0)=$S(CNT1=0:"-1^NO DATA FOUND",1:CNT1)
S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
Q
DT431 F S PSDATE=$O(^PS(55,DFN,5,"AUS",PSDATE)) Q:((+$G(PEDATE)>0)&(PSDATE>$G(PEDATE))) Q:PSDATE'>0 D
.S PSS56=0 F S PSS56=$O(^PS(55,DFN,5,"AUS",PSDATE,PSS56)) Q:PSS56'>0 S (PSSPO,PO)=PSS56 D DIQ431
S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
K CNT1,LIST,DA,DFN,DIC,DIQ,DR,IEN,PEDATE,PO,PSDATE,PSS,PSS56,PSSPO,PSSPO1,X Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS551 3629 printed Oct 16, 2024@18:31 Page 2
PSS551 ;BHM/DB - API FOR PHARMACY PATIENT FILE ;15 JUN 05
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**108,118,133,169,173**;9/30/97;Build 9
+2 ;DFN: IEN of Patient [REQUIRED]
+3 ;PO: Order # [optional]
+4 ;PSDATE: Start Date [optional]
+5 ;PEDATE: End Date [optional]
+6 ;If a start date is sent, an end date must also be sent
+7 ;LIST: Subscript name used in ^TMP global [REQUIRED]
+8 NEW PSSPO,PSSIEN,DA,DR,DIC,PSS,CNT1,X,PSSTMP
+9 IF $GET(LIST)=""
QUIT
+10 KILL ^TMP($JOB,LIST)
+11 IF $GET(DFN)=""
SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
QUIT
+12 SET PSSIEN=$GET(DFN)
SET PSSPO=$GET(PO)
SET ^TMP($JOB,LIST,0)=0
+13 IF $GET(PSSPO)>0
IF $GET(PSSIEN)>0
SET DA=PSSIEN
SET (IEN,DA(55.06))=PSSPO
GOTO DIQ431
+14 IF $GET(PSSPO)=""
IF $GET(PSDATE)'=""
IF $GET(PEDATE)'=""
SET PSDATE=$SELECT('$PIECE(PSDATE,".",2):PSDATE_.000001,1:PSDATE)
SET PEDATE=$SELECT('$PIECE($GET(PEDATE),".",2):PEDATE_.999999,1:$GET(PEDATE))
NEW PSS56
GOTO DT431
+15 IF $GET(PSSPO)=""
NEW PSSPO1
GOTO LOOP431
+16 QUIT
LOOP431 SET (PSSPO1,PSSPO)=0
FOR
SET PSSPO1=$ORDER(^PS(55,DFN,5,"B",PSSPO1))
if PSSPO1'>0
QUIT
FOR
SET PSSPO=$ORDER(^PS(55,DFN,5,"B",PSSPO1,PSSPO))
if PSSPO'>0
QUIT
SET PO=PSSPO
DO DIQ431
+1 QUIT
DIQ431 ;
+1 IF '$DATA(^PS(55,DFN,5,PO,0))
QUIT
+2 SET PSSIEN=PO_","_DFN_","
KILL DIQ
+3 DO GETS^DIQ(55.06,PSSIEN,".01;.5;1;2*;3;4;5;6;7;10;11;12;26;27;27.1;28;34;66;109","IE","^TMP(""PSS5506"",$J)")
+4 FOR X=.01,.5,1,3,4,5,6,7,10,11,12,26,27,27.1,28,34,66,109
SET ^TMP($JOB,LIST,+PSSPO,X)=$GET(^TMP("PSS5506",$JOB,55.06,PSSIEN,X,"I"))
+5 FOR X=.5,1,3,4,5,6,7,10,27,27.1,28,34
SET ^TMP($JOB,LIST,+PSSPO,X)=$SELECT($GET(^TMP("PSS5506",$JOB,55.06,PSSIEN,X,"E"))'="":^TMP($JOB,LIST,+PSSPO,X)_"^"_$GET(^TMP("PSS5506",$JOB,55.06,PSSIEN,X,"E")),1:"")
+6 SET PSSTMP=$PIECE($GET(^PS(55,DFN,5,PO,.2)),U)
SET ^TMP($JOB,LIST,IEN,108)=$SELECT($GET(PSSTMP)="":"",1:$$ORDITEM^PSS55(+PSSTMP))
+7 SET (PSS(1),CNT1)=0
FOR
SET PSS(1)=$ORDER(^TMP("PSS5506",$JOB,55.07,PSS(1)))
if 'PSS(1)
QUIT
Begin DoDot:1
+8 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.11)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.11,"I"))
+9 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.12)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.12,"I"))
+10 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.01)=$SELECT($GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.01,"E"))'="":$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.01,"I"))_"^"_$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.01,"E")),1:"")
+11 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.02)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.02,"I"))
+12 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.03)=$SELECT($GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.03,"E"))'="":$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.03,"I"))_"^"_$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.03,"E")),1:"")
+13 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.04)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.04,"I"))
+14 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.05)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.05,"I"))
+15 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.06)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.06,"I"))
+16 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.07)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.07,"I"))
+17 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.08)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.08,"I"))
+18 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.09)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.09,"I"))
+19 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",+PSS(1),.1)=$GET(^TMP("PSS5506",$JOB,55.07,PSS(1),.1,"I"))
+20 SET CNT1=CNT1+1
End DoDot:1
+21 KILL ^TMP("PSS5506",$JOB),PSS(1)
SET ^TMP($JOB,LIST,"B",+PSSPO)=""
+22 SET ^TMP($JOB,LIST,0)=^TMP($JOB,LIST,0)+1
+23 SET ^TMP($JOB,LIST,+PSSPO,"DDRUG",0)=$SELECT(CNT1=0:"-1^NO DATA FOUND",1:CNT1)
+24 SET ^TMP($JOB,LIST,0)=$SELECT(^TMP($JOB,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($JOB,LIST,0))
+25 QUIT
DT431 FOR
SET PSDATE=$ORDER(^PS(55,DFN,5,"AUS",PSDATE))
if ((+$GET(PEDATE)>0)&(PSDATE>$GET(PEDATE)))
QUIT
if PSDATE'>0
QUIT
Begin DoDot:1
+1 SET PSS56=0
FOR
SET PSS56=$ORDER(^PS(55,DFN,5,"AUS",PSDATE,PSS56))
if PSS56'>0
QUIT
SET (PSSPO,PO)=PSS56
DO DIQ431
End DoDot:1
+2 SET ^TMP($JOB,LIST,0)=$SELECT(^TMP($JOB,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($JOB,LIST,0))
+3 KILL CNT1,LIST,DA,DFN,DIC,DIQ,DR,IEN,PEDATE,PO,PSDATE,PSS,PSS56,PSSPO,PSSPO1,X
QUIT
