source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS51P1B.m@ 1639

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

initial load of WorldVistAEHR
File size: 6.8 KB
Line 
1PSS51P1B ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1 CONT.; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,118**;9/30/97;Build 8
3 ;
4SETZRO ;
5 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51P1(51.1,PSS(1),.01,"I"))
6 S ^TMP($J,LIST,"B",$G(PSS51P1(51.1,PSS(1),.01,"I")),+PSS(1))=""
7 S ^TMP($J,LIST,+PSS(1),1)=$G(PSS51P1(51.1,PSS(1),1,"I"))
8 S ^TMP($J,LIST,+PSS(1),2)=$G(PSS51P1(51.1,PSS(1),2,"I"))
9 S ^TMP($J,LIST,+PSS(1),4)=$G(PSS51P1(51.1,PSS(1),4,"I"))
10 S ^TMP($J,LIST,+PSS(1),5)=$S($G(PSS51P1(51.1,PSS(1),5,"I"))="":"",1:PSS51P1(51.1,PSS(1),5,"I")_"^"_PSS51P1(51.1,PSS(1),5,"E"))
11 S ^TMP($J,LIST,+PSS(1),6)=$G(PSS51P1(51.1,PSS(1),6,"I"))
12 S ^TMP($J,LIST,+PSS(1),2.5)=$G(PSS51P1(51.1,PSS(1),2.5,"I"))
13 S ^TMP($J,LIST,+PSS(1),8)=$G(PSS51P1(51.1,PSS(1),8,"I"))
14 S ^TMP($J,LIST,+PSS(1),8.1)=$G(PSS51P1(51.1,PSS(1),8.1,"I"))
15 Q
16 ;
17SETWARD ;
18 S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),.01)=$S($G(^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I"))="":"",1:^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I")_"^"_^TMP($J,"PSS51P1",51.11,PSS(2),.01,"E"))
19 S ^TMP($J,LIST,+PSS(1),"WARD",+PSS(2),1)=$G(^TMP($J,"PSS51P1",51.11,PSS(2),1,"I"))
20 Q
21 ;
22SETLOC ;
23 S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(1),.01)=$S($G(^TMP($J,"PSS51P1",51.17,PSS(1),.01,"I"))="":"",1:^TMP($J,"PSS51P1",51.17,PSS(1),.01,"I")_"^"_^TMP($J,"PSS51P1",51.17,PSS(1),.01,"E"))
24 S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(1),1)=$G(^TMP($J,"PSS51P1",51.17,PSS(1),1,"I"))
25 S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(1),2)=$G(^TMP($J,"PSS51P1",51.17,PSS(1),2,"I"))
26 Q
27 ;
28LOOP(PSSLP) ;
29 N CNT,CNT1,PSS S (CNT,PSS(3))=0
30 F S PSS(3)=$O(^PS(51.1,PSS(3))) Q:'PSS(3) D @(PSSLP)
31 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
32 K ^TMP("DILIST",$J)
33 Q
34 ;
35SETWRD2 ;
36 S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),.01)=$S($G(^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I"))="":"",1:^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I")_"^"_^TMP($J,"PSS51P1",51.11,PSS(2),.01,"E"))
37 S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),1)=$G(^TMP($J,"PSS51P1",51.11,PSS(2),1,"I"))
38 S ^TMP($J,LIST,+PSSIEN,"WARD",0)=1
39 Q
40 ;
411 ;
42 I $G(PSSTSCH)]"" Q:$P($G(^PS(51.1,PSS(3),0)),"^",5)'="O"
43 I $G(PSSPP)]"" Q:$P($G(^PS(51.1,PSS(3),0)),"^",4)'=PSSPP
44 S PSSIEN=PSS(3) K PSS51P1 D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1","IE","PSS51P1") S PSS(1)=0
45 F S PSS(1)=$O(PSS51P1(51.1,PSS(1))) Q:'PSS(1) D SETZRO S CNT=CNT+1
46 K PSS51P1
47 Q
48 ;
492 ;
50 S PSSIEN=PSS(3) K ^TMP($J,"PSS51P1")
51 I +$G(PSSIEN2)'>0 D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") S PSS(1)=0 D
52 .F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) D
53 ..S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I")),CNT=CNT+1
54 ..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))="" S (PSS(2),CNT1)=0 D
55 ...F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT1=CNT1+1
56 ...S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT1>0:CNT1,1:"-1^NO DATA FOUND")
57 I +$G(PSSIEN2)>0 D GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""") D
58 .S PSS(4)=0 F S PSS(4)=$O(^TMP($J,"PSS51P1",51.1,PSS(4))) Q:'PSS(4) D
59 ..S ^TMP($J,LIST,+PSS(4),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(4),.01,"I")),CNT=CNT+1
60 ..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(4),.01,"E")),+PSS(4))=""
61 ..D GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
62 ..S PSS(1)=+PSSIEN,(PSS(2),CNT1)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT1=CNT1+1
63 ..S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT1>0:CNT1,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
64 K ^TMP($J,"PSS51P1")
65 Q
663 ;
67 S PSSIEN=PSS(3) K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;7*","IE","^TMP($J,""PSS51P1""") S (PSS(1),CNT1)=0 D
68 .F S PSS(1)=$O(^TMP($J,"PSS51P1",51.17,PSS(1))) Q:'PSS(1) D SETLOC S CNT1=CNT1+1
69 .S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT1>0:CNT1,1:"-1^NO DATA FOUND")
70 .S PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.1,PSS(2))) Q:'PSS(2) D
71 ..S ^TMP($J,LIST,+PSS(2),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"I")),CNT=CNT+1
72 ..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(2),.01,"E")),+PSS(2))=""
73 K ^TMP($J,"PSS51P1")
74 Q
754 ;
76 S PSSIEN=PSS(3)
77 D GETS^DIQ(51.1,+PSSIEN,".01;1","IE","PSS51P1")
78 N PSSXX S PSSXX=0 F S PSSXX=$O(PSS51P1(51.1,PSSXX)) Q:'PSSXX D
79 .S ^TMP($J,LIST,+PSSXX,.01)=$G(PSS51P1(51.1,PSSXX,.01,"E")),CNT=CNT+1
80 .S ^TMP($J,LIST,"B",$G(PSS51P1(51.1,PSSXX,.01,"E")),+PSSXX)=""
81 .S ^TMP($J,LIST,+PSSXX,1)=$G(PSS51P1(51.1,PSSXX,1,"E"))
82 K PSS51P1
83 Q
845 ;
85 I $G(PSSPP)]"",$P($G(^PS(51.1,+PSS(3),0)),"^",4)'=$G(PSSPP) Q
86 I $G(PSSTYP)]"",$P($G(^PS(51.1,+PSS(3),0)),"^",5)'[PSSTYP Q
87 D FIND^DIC(51.1,,"@;.01;1;2;2.5;4;5IE;8","Q","`"_PSS(3),,,,"")
88 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,"ID",PSSXX)) Q:'PSSXX D
89 .S PSSIEN=+PSS(3)
90 .I $$FREQ^PSS51P1(+$G(^TMP("DILIST",$J,"ID",PSSXX,2)),PSSFREQ) Q
91 .S CNT=CNT+1
92 .S ^TMP($J,LIST,+PSSIEN,.01)=$G(^TMP("DILIST",$J,"ID",PSSXX,.01))
93 .S ^TMP($J,LIST,"AP"_PSSPP,$G(^TMP("DILIST",$J,"ID",PSSXX,.01)),+PSSIEN)=""
94 .S ^TMP($J,LIST,+PSSIEN,1)=$G(^TMP("DILIST",$J,"ID",PSSXX,1))
95 .S ^TMP($J,LIST,+PSSIEN,2)=$G(^TMP("DILIST",$J,"ID",PSSXX,2))
96 .S ^TMP($J,LIST,+PSSIEN,2.5)=$G(^TMP("DILIST",$J,"ID",PSSXX,2.5))
97 .S ^TMP($J,LIST,+PSSIEN,4)=$G(^TMP("DILIST",$J,"ID",PSSXX,4))
98 .S ^TMP($J,LIST,+PSSIEN,5)=$S($G(^TMP("DILIST",$J,"ID",PSSXX,5,"I"))="":"",1:$G(^TMP("DILIST",$J,"ID",PSSXX,5,"I"))_"^"_$G(^TMP("DILIST",$J,"ID",PSSXX,5,"E")))
99 .S ^TMP($J,LIST,+PSSIEN,8)=$G(^TMP("DILIST",$J,"ID",PSSXX,8))
100 .D HOSPLOC^PSS51P1A(LIST,+PSSIEN)
101 .I +$G(PSSWDIEN)'>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
102 ..S PSS(1)=+PSSIEN,(PSS(2),CNT1)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT1=CNT1+1
103 ..S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT1>0:CNT1,1:-1_"^"_"NO DATA FOUND")
104 .I +$G(PSSWDIEN)>0 K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") D
105 ..S (PSS(2),CNT1)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D
106 ...I PSSWDIEN=$P($G(^TMP($J,"PSS51P1",51.11,PSS(2),.01,"I")),"^") D SETWRD2^PSS51P1B S CNT1=CNT1+1
107 ..S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT1>0:CNT1,1:"-1^NO DATA FOUND FOR PSSWDIEN #"_PSSWDIEN)
108 K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
109 Q
110 ;
1116 ;
112 I $G(PSSPP)]"",$P($G(^PS(51.1,+PSS(3),0)),"^",4)'=PSSPP Q
113 K PSS51P1 D GETS^DIQ(51.1,+PSS(3),".01;1;2;2.5;4;5;6;8;8.1","IE","PSS51P1")
114 N PSSXX S PSSXX=0 F S PSSXX=$O(PSS51P1(51.1,PSSXX)) Q:'PSSXX D
115 .S ^TMP($J,LIST,+PSSXX,.01)=$G(PSS51P1(51.1,PSSXX,.01,"E")),CNT=CNT+1
116 .S ^TMP($J,LIST,"AP"_PSSPP,$G(PSS51P1(51.1,PSSXX,.01,"E")),+PSSXX)=""
117 .S ^TMP($J,LIST,+PSSXX,1)=$G(PSS51P1(51.1,PSSXX,1,"E"))
118 .S ^TMP($J,LIST,+PSSXX,2)=$G(PSS51P1(51.1,PSSXX,2,"E"))
119 .S ^TMP($J,LIST,+PSSXX,2.5)=$G(PSS51P1(51.1,PSSXX,2.5,"E"))
120 .S ^TMP($J,LIST,+PSSXX,4)=$G(PSS51P1(51.1,PSSXX,4,"E"))
121 .S ^TMP($J,LIST,+PSSXX,5)=$S($G(PSS51P1(51.1,PSSXX,5,"I"))]"":$G(PSS51P1(51.1,PSSXX,5,"I"))_"^"_$G(PSS51P1(51.1,PSSXX,5,"E")),1:"")
122 .S ^TMP($J,LIST,+PSSXX,6)=$G(PSS51P1(51.1,PSSXX,6,"E"))
123 .S ^TMP($J,LIST,+PSSXX,8)=$G(PSS51P1(51.1,PSSXX,8,"E"))
124 .S ^TMP($J,LIST,+PSSXX,8.1)=$G(PSS51P1(51.1,PSSXX,8.1,"E"))
125 K PSS51P1
126 Q
Note: See TracBrowser for help on using the repository browser.