source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS55.m@ 1724

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1PSS55 ;BHM/DB/TSS - API FOR PHARMACY PATIENT FILE ;15 JUN 05
2 ;;1.0;PHARMACY DATA MANAGEMENT;**101,108,118,88**;9/30/97;Build 12
3 ;
4PSS431(DFN,PO,PSDATE,PEDATE,LIST) ;
5 G ^PSS551
6PSS432(DFN,PO,LIST) ;SRS 3.2.43.2
7 N D0,DA,DR,DIC,IEN,PSSTMP,PSSTMP2
8 ;DFN: IEN of Patient [REQUIRED]
9 ;PO: Order # IEN [optional] If left blank, all active orders will be returned
10 ;LIST: Subscript name used in ^TMP global [REQUIRED]
11 N PSSPO,PSSDT,PSSIEN,PSSDATA,PSSQ
12 Q:$G(LIST)="" K ^TMP($J,LIST)
13 I +$G(DFN)'>0 G NODATA
14 S ^TMP($J,LIST,0)=0
15 I '$D(^PS(55,DFN,0)) G NODATA
16 I $G(PO)'="",$D(^PS(55,DFN,5,PO)) S PSSPO=$P(^PS(55,DFN,5,PO,0),"^") I $G(PSSPO)>0 S (DA(55.06),IEN)=PO G AUS2
17 I $G(PO)'="",$G(PSSPO)="" G NODATA
18 S PSSDT=0
19AUS ;Loop through stop date/time xref
20 F S PSSDT=$O(^PS(55,DFN,5,"AUS",PSSDT)) Q:PSSDT'>0 S PSSIEN=0 D
21 .F S PSSIEN=$O(^PS(55,DFN,5,"AUS",PSSDT,PSSIEN)) Q:PSSIEN'>0 D
22 ..S (IEN,DA(55.06))=PSSIEN,PSSDATA=$G(^PS(55,DFN,5,PSSIEN,0)) I $P(PSSDATA,"^",9)'="A" Q
23 ..D AUSDIQ
24 S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
25 K PSSIEN,PSSDT,PSSDATA,LIST
26 Q
27AUSDIQ K ^UTILITY("DIQ1",$J),DIQ
28 S DA=DFN,DIC=55,DR=62,DR(55.06)=".01;.5;1;3;4;5;6;7;9;11;12;26;27;27.1;28",DIQ(0)="IE" D EN^DIQ1
29 S PSSPO=$G(^UTILITY("DIQ1",$J,55.06,IEN,.01,"E")) F X=.01,.5,1,3,4,5,6,7,9,11,12,26,27,27.1,28 S ^TMP($J,LIST,IEN,X)=$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"I"))
30 F X=.5,1,3,4,5,6,7,9,27,27.1,28 S ^TMP($J,LIST,IEN,X)=$S($G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E"))'="":^TMP($J,LIST,IEN,X)_"^"_$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E")),1:"")
31 S PSSTMP=$P($G(^PS(55,DFN,5,IEN,.2)),U) I PSSTMP'="" S ^TMP($J,LIST,IEN,108)=$$ORDITEM(+PSSTMP)
32 K ^UTILITY("DIQ1",$J),DIQ
33 S ^TMP($J,LIST,"B",IEN)="",^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
34 Q
35ORDITEM(PSSTMP) ;
36 ;Reference to ^PSNDF(50.606 is supported by DBIA 2174
37 S PSSTMP2=$G(^PS(50.7,PSSTMP,0))
38 I PSSTMP2'="" S PSSTMP=PSSTMP_U_$P($G(PSSTMP2),U)_U_$P($G(PSSTMP2),U,2)_U_$P($G(^PS(50.606,$P($G(PSSTMP2),U,2),0)),U,1)
39 Q PSSTMP
40AUS2 ;one PO
41 S PSSQ=1 D AUSDIQ
42 S ^TMP($J,LIST,0)=$S(^TMP($J,LIST,0)=0:"-1^NO DATA FOUND",1:^TMP($J,LIST,0))
43AUSQ K PSSDT,PSSIEN,PSSDATA,PSSPO,LIST,X,PSSQ,DA,DR,DIC Q
44 ;
45PSS433(DFN,LIST) ;
46 ;DFN: IEN of Patient [REQUIRED]
47 ;LIST: Subscript name used in ^TMP global [REQUIRED]
48 N X,DA,DR,PSSPO,PSSIEN,D0,IEN,PSSTMP,PSSTMP2
49 Q:$G(LIST)="" K ^TMP($J,LIST)
50 I $G(DFN)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
51 I '$D(^PS(55,DFN)) G NODATA
52 S PSSIEN=0,^TMP($J,LIST,0)=0
53BGN433 S PSSIEN=$O(^PS(55,DFN,5,PSSIEN)) G Q433:PSSIEN'>0 S PSSPO=$P($G(^PS(55,DFN,5,PSSIEN,0)),"^")
54 S (IEN,DA(55.06))=PSSIEN,DIC=55,DA=DFN,DR=62,DR(55.06)=".5;9;25;26;34;41;42;70",DIQ(0)="IE" D EN^DIQ1
55 F X=.5,9,25,26,34,41,42,70 S ^TMP($J,LIST,+PSSIEN,X)=$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"I"))
56 S PSSTMP=$P($G(^PS(55,DFN,5,PSSIEN,.2)),U) I PSSTMP'="" S ^TMP($J,LIST,PSSIEN,108)=$$ORDITEM(+PSSTMP)
57 F X=.5,9,25,34,70 S ^TMP($J,LIST,+PSSIEN,X)=$S($G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E"))'="":^TMP($J,LIST,+PSSIEN,X)_"^"_$G(^UTILITY("DIQ1",$J,55.06,IEN,X,"E")),1:"")
58 S ^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
59 S ^TMP($J,LIST,"B",+PSSIEN)=""
60 G BGN433
61Q433 K ^UTILITY("DIQ1",$J),PSSIEN,X,DR,DIC,DA,LIST Q
62PSS435(DFN,PO,LIST) ;SRS 3.2.43.5
63 N D0,DA,DIC,DR,IEN,X,PSSPO,PSSDATA,PSSIEN,PSSDT,PSSTMP,PSSTMP2,PSSSTAT
64 ;DFN: IEN of Patient [REQUIRED]
65 ;PO: Order # [optional] If left blank, all active orders will be returned.
66 ;LIST: Subscript name used in ^TMP global [REQUIRED]
67 ;Active hyperal orders utilizing "AIT" cross reference
68 Q:$G(LIST)="" K ^TMP($J,LIST)
69 I $G(DFN)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
70 I '$D(^PS(55,DFN,"IV","AIT","H")) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
71 S PSSDT=0,^TMP($J,LIST,0)=0
72AIT ;loop trough AIT xref
73 S PSSDT=$O(^PS(55,DFN,"IV","AIT","H",PSSDT)) G AITQ:PSSDT'>0 S PSSIEN=0
74AIT1 S PSSIEN=$O(^PS(55,DFN,"IV","AIT","H",PSSDT,PSSIEN)) G AIT:PSSIEN'>0
75 S PSSDATA=$G(^PS(55,DFN,"IV",PSSIEN,0)),PSSSTAT=$P($G(PSSDATA),"^",17) I PSSSTAT'="A",$G(PO)'>0 G AIT1
76 I +$G(PO)>0 G AIT1:PSSIEN'=PO
77 S PSSPO=$P(PSSDATA,"^",1),^TMP($J,LIST,"B",+PSSIEN)=""
78AITDIQ K ^UTILITY("DIQ1",$J) S DA=DFN,(IEN,DA(55.01))=PSSIEN,DIC=55,DR=100,DIQ(0)="IE",DR(55.01)=".01;.02;.03;.04;.06;.08;.09;.12;.17;.24;9;31;100;104;106;108;110;112;120;121;132" D EN^DIQ1
79 F X=.01,.02,.03,.04,.06,.08,.09,.12,.17,.24,9,31,100,104,106,108,110,112,120,121,132 S ^TMP($J,LIST,PSSPO,X)=$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"I"))
80 F X=.02,.03,.04,.06,9,100,106,108,112,120,121,132 S ^TMP($J,LIST,PSSPO,X)=$S($G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E"))'="":^TMP($J,LIST,PSSPO,X)_"^"_$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E")),1:"")
81 S PSSTMP=$P($G(^PS(55,DFN,"IV",PSSIEN,.2)),U) I PSSTMP'="" S ^TMP($J,LIST,PSSIEN,130)=$$ORDITEM(+PSSTMP)
82 K ^UTILITY("DIQ1",$J)
83 S ^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
84 G AIT1
85AITQ I $G(^TMP($J,LIST,0))=0 K ^TMP($J,LIST) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
86 K PSSIEN,PSSDT,PSSSTAT,PSSDATA,PO,X,LIST Q
87 ;
88PSS436(DFN,ORDER,LIST) ;SRS 3.2.43.6
89 N D0,IEN,X,PSSTMP,PSSTMP2,DA,PSSLOOP,PSSPO,DIC,DR,PSSTMP,PSSA,PSSS,PSSDATA
90 ;DFN: IEN of Patient [REQUIRED]
91 ;ORDER: ORDER NUMBER [REQUIRED]
92 ;LIST: Subscript name used in ^TMP global [REQUIRED]
93 ;Active IV AD nodes
94 K PSSLOOP Q:$G(LIST)="" K ^TMP($J,LIST) I $G(DFN)'>0 S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
95 I '$D(^PS(55,DFN)) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
96 K ^TMP($J,LIST) I $G(ORDER)="" S PSSLOOP=1 S ORDER=0 G LOOP436
97 I $G(ORDER)'="" S PSSPO=$O(^PS(55,DFN,"IV","B",ORDER,0)) G PSS436Q:$G(PSSPO)'>0 G DIQ436
98LOOP436 S ORDER=$O(^PS(55,DFN,"IV","B",ORDER)) G PSS436Q:ORDER'>0 S PSSPO=$O(^PS(55,DFN,"IV","B",ORDER,0))
99DIQ436 K DA,DR S DA=DFN,(IEN,DA(55.01))=PSSPO,DIC=55,DR=100
100 S DR(55.01)=".01;.02;.03;.04;.06;.08;.09;.12;.17;.24;9;31;100;104;106;108;110;112;120;121;132;147"
101 S DIQ(0)="IE" D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J)) G NODATA
102 F X=.01,.02,.03,.04,.06,.08,.09,.12,.17,.24,9,31,100,104,106,108,110,112,120,121,132,147 S ^TMP($J,LIST,PSSPO,X)=$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"I"))
103 F X=.02,.03,.04,.06,9,100,106,108,112,120,121,132,147 S ^TMP($J,LIST,PSSPO,X)=$S($G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E"))'="":^TMP($J,LIST,PSSPO,X)_"^"_$G(^UTILITY("DIQ1",$J,55.01,IEN,X,"E")),1:"")
104 S PSSTMP=$P($G(^PS(55,DFN,"IV",PSSPO,.2)),U) I PSSTMP'="" S ^TMP($J,LIST,PSSPO,130)=$$ORDITEM(+PSSTMP)
105 S ^TMP($J,LIST,"B",PSSPO)="",PSSA=0,^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
106 S ^TMP($J,LIST,PSSPO,"ADD",0)=0
107PSSA S PSSA=$O(^PS(55,DFN,"IV",PSSPO,"AD",PSSA)) I PSSA'>0 S PSSS=0 S ^TMP($J,LIST,PSSPO,"SOL",0)=0 G PSSS
108 S PSSDATA=$G(^PS(55,DFN,"IV",PSSPO,"AD",PSSA,0)),X1=$P(PSSDATA,"^"),X2=$P(PSSDATA,"^",2),X3=$P(PSSDATA,"^",3)
109 S ^TMP($J,LIST,PSSPO,"ADD",PSSA,.01)=X1_"^"_$P($G(^PS(52.6,X1,0)),"^")
110 S ^TMP($J,LIST,PSSPO,"ADD",PSSA,.02)=X2
111 S ^TMP($J,LIST,PSSPO,"ADD",PSSA,.03)=X3
112 S ^TMP($J,LIST,PSSPO,"ADD",0)=$G(^TMP($J,LIST,PSSPO,"ADD",0))+1
113 G PSSA
114PSSS I ^TMP($J,LIST,PSSPO,"ADD",0)'>0 S ^TMP($J,LIST,PSSPO,"ADD",0)="-1^NO DATA FOUND"
115 S PSSS=$O(^PS(55,DFN,"IV",PSSPO,"SOL",PSSS)) I PSSS'>0,$G(PSSLOOP)'=1 D G PSS436Q
116 .I ^TMP($J,LIST,PSSPO,"SOL",0)=0 S ^TMP($J,LIST,PSSPO,"SOL",0)="-1^NO DATA FOUND"
117 I PSSS'>0 D G LOOP436
118 .I ^TMP($J,LIST,PSSPO,"SOL",0)=0 S ^TMP($J,LIST,PSSPO,"SOL",0)="-1^NO DATA FOUND"
119 S PSSDATA=$G(^PS(55,DFN,"IV",PSSPO,"SOL",PSSS,0)),X1=$P(PSSDATA,"^"),X2=$P(PSSDATA,"^",2)
120 S ^TMP($J,LIST,PSSPO,"SOL",PSSS,.01)=X1_"^"_$P($G(^PS(52.7,X1,0)),"^")
121 S ^TMP($J,LIST,PSSPO,"SOL",PSSS,1)=X2
122 S ^TMP($J,LIST,PSSPO,"SOL",0)=$G(^TMP($J,LIST,PSSPO,"SOL",0))+1
123 G PSSS
124PSS436Q K ^UTILITY("DIQ1",$J),DIQ I '$D(^TMP($J,LIST,"B")) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
125 K PSSPO,PSSA,PSSDATA,X,LIST,X1,X2,PSSS,ORDER,PSSLOOP,DA,DR,DIC Q
126NODATA S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
127Q K IEN,PSSA,PSSS,PSSSTAT,X,LIST,X1,X2,X3,PSSDIY Q
Note: See TracBrowser for help on using the repository browser.