source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS551.m@ 1703

Last change on this file since 1703 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1PSS551 ;BHM/DB - API FOR PHARMACY PATIENT FILE ;15 JUN 05
2 ;;1.0;PHARMACY DATA MANAGEMENT;**108,118**;9/30/97;Build 8
3 ;DFN: IEN of Patient [REQUIRED]
4 ;PO: Order # [optional]
5 ;PSDATE: Start Date [optional]
6 ;PEDATE: End Date [optional]
7 ;If a start date is sent, an end date must also be sent
8 ;LIST: Subscript name used in ^TMP global [REQUIRED]
9 N PSSPO,PSSIEN,DA,DR,DIC,PSS,CNT1,X,PSSTMP
10 I $G(LIST)="" Q
11 K ^TMP($J,LIST)
12 I $G(DFN)="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
13 S PSSIEN=$G(DFN),PSSPO=$G(PO) S ^TMP($J,LIST,0)=0
14 I $G(PSSPO)>0,$G(PSSIEN)>0 S DA=PSSIEN,(IEN,DA(55.06))=PSSPO G DIQ431
15 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
16 I $G(PSSPO)="" N PSSPO1 G LOOP431
17 Q
18LOOP431 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
19 Q
20DIQ431 ;
21 I '$D(^PS(55,DFN,5,PO,0)) Q
22 S PSSIEN=PO_","_DFN_"," K DIQ
23 D GETS^DIQ(55.06,PSSIEN,".01;.5;1;2*;3;4;5;6;7;11;12;27;27.1;28;66","IE","^TMP(""PSS5506"",$J)")
24 F X=.01,.5,1,3,4,5,6,7,11,12,27,27.1,28,66 S ^TMP($J,LIST,+PSSPO,X)=$G(^TMP("PSS5506",$J,55.06,PSSIEN,X,"I"))
25 F X=.5,1,3,4,5,6,7,27,27.1,28 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:"")
26 S PSSTMP=$P($G(^PS(55,DFN,5,PO,.2)),U) I PSSTMP'="" S ^TMP($J,LIST,PO,108)=$$ORDITEM^PSS55(+PSSTMP)
27 S (PSS(1),CNT1)=0 F S PSS(1)=$O(^TMP("PSS5506",$J,55.07,PSS(1))) Q:'PSS(1) D
28 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.11)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.11,"I"))
29 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.12)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.12,"I"))
30 .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:"")
31 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.02)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.02,"I"))
32 .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:"")
33 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.04)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.04,"I"))
34 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.05)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.05,"I"))
35 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.06)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.06,"I"))
36 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.07)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.07,"I"))
37 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.08)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.08,"I"))
38 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.09)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.09,"I"))
39 .S ^TMP($J,LIST,+PSSPO,"DDRUG",+PSS(1),.1)=$G(^TMP("PSS5506",$J,55.07,PSS(1),.1,"I"))
40 .S CNT1=CNT1+1
41 K ^TMP("PSS5506",$J),PSS(1) S ^TMP($J,LIST,"B",+PSSPO)=""
42 S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1
43 S ^TMP($J,LIST,+PSSPO,"DDRUG",0)=$S(CNT1=0:"-1^NO DATA FOUND",1:CNT1)
44 S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
45 Q
46DT431 F S PSDATE=$O(^PS(55,DFN,5,"AUS",PSDATE)) Q:((+$G(PEDATE)>0)&(PSDATE>$G(PEDATE))) Q:PSDATE'>0 D
47 .S PSS56=0 F S PSS56=$O(^PS(55,DFN,5,"AUS",PSDATE,PSS56)) Q:PSS56'>0 S (PSSPO,PO)=PSS56 D DIQ431
48 S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
49 K CNT1,LIST,DA,DFN,DIC,DIQ,DR,IEN,PEDATE,PO,PSDATE,PSS,PSS56,PSSPO,PSSPO1,X Q
Note: See TracBrowser for help on using the repository browser.