source: FOIAVistA/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS51P1C.m@ 761

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1PSS51P1C ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4ALL ;
5 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"") D
6 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
7 .S ^TMP($J,LIST,0)=1
8 .D GETS^DIQ(51.1,+PSSIEN2,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
9 .F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
10 .S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
11 .S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
12 .S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
13 .S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
14 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
15 .I PSSFT["??" D LOOP(1) Q
16 .D FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",,,"")
17 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
18 .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
19 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS51P1",$J) D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
20 ..F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
21 ..S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
22 ..S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
23 ..S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
24 ..S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
25 K ^TMP("DILIST",$J),^TMP("PSS51P1",$J)
26 Q
27 ;
28SETZRO ;
29 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),.01,"I"))
30 S ^TMP($J,LIST,"B",$G(^TMP("PSS51P1",$J,51.1,PSS(1),.01,"I")),+PSS(1))=""
31 S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),1,"I"))
32 S ^TMP($J,LIST,+PSS(1),2)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),2,"I"))
33 S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),4,"I"))
34 S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P1",$J,51.1,PSS(1),5,"I"))="":"",1:^TMP("PSS51P1",$J,51.1,PSS(1),5,"I")_"^"_^TMP("PSS51P1",$J,51.1,PSS(1),5,"E"))
35 S ^TMP($J,LIST,+PSS(1),6)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),6,"I"))
36 S ^TMP($J,LIST,+PSS(1),2.5)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),2.5,"I"))
37 S ^TMP($J,LIST,+PSS(1),8)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),8,"I"))
38 S ^TMP($J,LIST,+PSS(1),8.1)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),8.1,"I"))
39 Q
40 ;
41SETWARD ;
42 S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),.01)=$S($G(^TMP("PSS51P1",$J,51.11,PSS(2),.01,"I"))="":"",1:^TMP("PSS51P1",$J,51.11,PSS(2),.01,"I")_"^"_^TMP("PSS51P1",$J,51.11,PSS(2),.01,"E"))
43 S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),1)=$G(^TMP("PSS51P1",$J,51.11,PSS(2),1,"I"))
44 Q
45 ;
46SETLOC ;
47 S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),.01)=$S($G(^TMP("PSS51P1",$J,51.17,PSS(3),.01,"I"))="":"",1:^TMP("PSS51P1",$J,51.17,PSS(3),.01,"I")_"^"_^TMP("PSS51P1",$J,51.17,PSS(3),.01,"E"))
48 S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),1)=$G(^TMP("PSS51P1",$J,51.17,PSS(3),1,"I"))
49 S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),2)=$G(^TMP("PSS51P1",$J,51.17,PSS(3),2,"I"))
50 Q
51 ;
52LOOP(PSSLP) ;
53 N CNT,CNT2,CNT3,PSSIEN S (CNT,PSSIEN)=0
54 F S PSSIEN=$O(^PS(51.1,PSSIEN)) Q:'PSSIEN D @(PSSLP) S CNT=CNT+1
55 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
56 K ^TMP("DILIST",$J),^TMP("PSS51P1",$J)
57 Q
581 ;
59 K ^TMP("PSS51P1",$J) D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
60 F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
61 S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
62 S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
63 S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
64 S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
65 Q
66 ;
67WARD ;
68 I +$G(PSSIEN2)>0,+$G(PSSIEN)>0 D GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""") D
69 .D GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""") S PSS(1)=0 F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) D
70 ..S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I"))
71 ..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
72 .S PSS(1)=+PSSIEN,PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
73 .S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
74 .S ^TMP($J,LIST,0)=$S($G(^TMP($J,LIST,+PSSIEN,.01))]"":1,1:"-1^NO DATA FOUND")
75 I +$G(PSSIEN)>0,+$G(PSSIEN2)'>0 N PSSIEN3 S PSSIEN3=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"") D
76 .I +PSSIEN3'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
77 .S ^TMP($J,LIST,0)=1
78 .D GETS^DIQ(51.1,+PSSIEN3,".01;3*","IE","^TMP($J,""PSS51P1""") S PSS(1)=0 D
79 ..F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) S ^TMP($J,LIST,+PSS(1),.01)=^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I") D
80 ...S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))="" S PSS(2)=0
81 ...F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
82 ..S ^TMP($J,LIST,+PSSIEN3,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
83 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
84 .I PSSFT["??" D LOOP^PSS51P1B(2) Q
85 .D FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"B",,,"")
86 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
87 .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
88 .I +$G(PSSIEN2)'>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
89 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") S (PSS(1),CNT)=0 D
90 ...F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) D
91 ....S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I"))
92 ....S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))="" S (PSS(2),CNT)=0 D
93 .....F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
94 .....S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
95 .I +$G(PSSIEN2)>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
96 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""")
97 ..S PSS(3)=0 F S PSS(3)=$O(^TMP($J,"PSS51P1",51.1,PSS(3))) Q:'PSS(3) D
98 ...S ^TMP($J,LIST,+PSS(3),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(3),.01,"I"))
99 ...S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(3),.01,"E")),+PSS(3))=""
100 ...D GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
101 ...S PSS(1)=+PSSIEN,(PSS(2),CNT)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
102 ...S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
103 K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
104 Q
Note: See TracBrowser for help on using the repository browser.