source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS52P6B.m@ 949

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

initial load of WorldVistAEHR
File size: 7.2 KB
RevLine 
[613]1PSS52P6B ;BIR/LDT - API FOR INFORMATION FROM FILE 52.6 CONT.; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4ELYTES ;
5 S SCR("S")=""
6 I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
7 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"") D
8 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
9 .S ^TMP($J,LIST,0)=1
10 .D GETS^DIQ(52.6,+PSSIEN2,".01;8*","IE","^TMP(""PSS52P6"",$J)") S PSS(1)=0
11 .F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
12 ..S ^TMP($J,LIST,+PSSIEN2,.01)=^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I")
13 ..S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(1),.01,"I"),+PSSIEN2)=""
14 .N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.62,PSS(1))) Q:'PSS(1) D SETLTS^PSS52P6A S CNT=CNT+1
15 .S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
16 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
17 .I PSSFT["??" D LOOP^PSS52P6A(3) Q
18 .D FIND^DIC(52.6,,"@;.01;2","QP",PSSFT,,"B",SCR("S"),,"")
19 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
20 .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
21 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,"8*","IE","^TMP(""PSS52P6"",$J)") D
22 ...S ^TMP($J,LIST,+PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
23 ...S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),+PSSIEN)=""
24 ..N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.62,PSS(1))) Q:'PSS(1) D SETLTS^PSS52P6A S CNT=CNT+1
25 ..S ^TMP($J,LIST,+PSSIEN,"ELYTES",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
26 K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
27 Q
28 ;
29SYNONYM ;
30 S SCR("S")=""
31 I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
32 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"") D
33 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
34 .S ^TMP($J,LIST,0)=1
35 .D GETS^DIQ(52.6,+PSSIEN2,".01;9*","IE","^TMP(""PSS52P6"",$J)") S PSS(1)=0
36 .N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.63,PSS(1))) Q:'PSS(1) D SETSYN^PSS52P6A S CNT=CNT+1
37 .S PSS(2)=0 F S PSS(2)=$O(^TMP("PSS52P6",$J,52.6,PSS(2))) Q:'PSS(2) D
38 ..S ^TMP($J,LIST,+PSS(2),.01)=^TMP("PSS52P6",$J,52.6,PSS(2),.01,"I")
39 ..S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(2),.01,"I"),+PSS(2))=""
40 .S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
41 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
42 .I PSSFT["??" D LOOP^PSS52P6A(4) Q
43 .D FIND^DIC(52.6,,"@;.01;2","QP",PSSFT,,"B",SCR("S"),,"")
44 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
45 .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
46 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,"9*","IE","^TMP(""PSS52P6"",$J)") D
47 ...S ^TMP($J,LIST,+PSSIEN,.01)=$P(^TMP("DILIST",$J,PSSXX,0),"^",2)
48 ...S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSSXX,0),"^",2),+PSSIEN)=""
49 ..N CNT S (PSS(1),CNT)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.63,PSS(1))) Q:'PSS(1) D SETSYN^PSS52P6A S CNT=CNT+1
50 ..S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
51 K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
52 Q
53 ;
54DRGINFO ;
55 S SCR("S")=""
56 I +$G(PSSFL)>1 N ND D SETSCRN^PSS52P6A
57 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(52.6,"","A","`"_PSSIEN,,SCR("S"),"") D
58 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
59 .S ^TMP($J,LIST,0)=1
60 .D GETS^DIQ(52.6,+PSSIEN2,".01;10","E","^TMP(""PSS52P6"",$J)")
61 .S PSS(1)=0 F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
62 ..S ^TMP($J,LIST,+PSS(1),.01)=^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E")
63 ..S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E"),+PSS(1))=""
64 ..S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3))) Q:'PSS(3) D SETDRI^PSS52P6A
65 ..I '$D(^TMP($J,LIST,+PSS(1),"DRGINF")) S ^TMP($J,LIST,+PSS(1),"DRGINF",0)="-1^NO DATA FOUND"
66 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
67 .I PSSFT["??" D LOOP^PSS52P6A(5) Q
68 .D FIND^DIC(52.6,,"@;.01","QP",PSSFT,,"B^C^D",SCR("S"),,"")
69 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
70 .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
71 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,".01;10","E","^TMP(""PSS52P6"",$J)") S PSS(1)=0
72 ..F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D
73 ...S ^TMP($J,LIST,+PSS(1),.01)=^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E")
74 ...S ^TMP($J,LIST,"B",^TMP("PSS52P6",$J,52.6,PSS(1),.01,"E"),+PSS(1))=""
75 ...S PSS(3)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.6,PSS(1),10,PSS(3))) Q:'PSS(3) D SETDRI^PSS52P6A
76 ...I '$D(^TMP($J,LIST,+PSS(1),"DRGINF")) S ^TMP($J,LIST,+PSS(1),"DRGINF",0)="-1^NO DATA FOUND"
77 K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
78 Q
79 ;
80DRGIEN ;
81 S SCR("S")=""
82 I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
83 D FIND^DIC(52.6,,"@;.01","QPX",PSS50,,"AC",SCR("S"),,"")
84 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
85 I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
86 .S ^TMP($J,LIST,+^TMP("DILIST",$J,XX,0),.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
87 .S ^TMP($J,LIST,"AC",$P(^TMP("DILIST",$J,XX,0),"^",2),+^TMP("DILIST",$J,XX,0))=""
88 K ^TMP("DILIST",$J)
89 Q
90 ;
91LOOKUP ;
92 S SCR("S")="" N PSSIEN,CNT,CNT2,CNT3,QFLG S CNT3=0
93 I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
94 I +$G(PSS50P7)>0 D FIND^DIC(52.6,,"@;.01","QPX",PSS50P7,,"AOI",SCR("S"),,"")
95 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
96 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
97 .S PSSIEN=$P(^TMP("DILIST",$J,PSSXX,0),"^")
98 .K PSS52P6 D GETS^DIQ(52.6,+PSSIEN,"1","I","PSS52P6") S QFLG=0 D CHK:+$G(PSSFL)>0 Q:QFLG
99 .K ^TMP("PSS52P6",$J) D GETS^DIQ(52.6,+PSSIEN,".01;14;6*;9*","IE","^TMP(""PSS52P6"",$J)") S PSS(1)=0 D
100 ..F S PSS(1)=$O(^TMP("PSS52P6",$J,52.6,PSS(1))) Q:'PSS(1) D SETZRO2^PSS52P6A S CNT3=CNT3+1
101 ..S ^TMP($J,LIST,0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
102 ..S (PSS(2),CNT)=0 F S PSS(2)=$O(^TMP("PSS52P6",$J,52.61,PSS(2))) Q:'PSS(2) D SETQCD2^PSS52P6A S CNT=CNT+1
103 ..S ^TMP($J,LIST,+PSSIEN,"QCODE",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
104 ..S (PSS(3),CNT2)=0 F S PSS(3)=$O(^TMP("PSS52P6",$J,52.63,PSS(3))) Q:'PSS(3) D SETSYN2^PSS52P6A S CNT2=CNT2+1
105 ..S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
106 K ^TMP("DILIST",$J),^TMP("PSS52P6",$J)
107 Q
108 ;
109POI ;
110 S SCR("S")=""
111 I +$G(PSSFL)>0 N ND D SETSCRN^PSS52P6A
112 D FIND^DIC(52.6,,"@;.01","QPX",PSSOI,,"AOI",SCR("S"),,"")
113 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
114 I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N XX S XX=0 F S XX=$O(^TMP("DILIST",$J,XX)) Q:'XX D
115 .S ^TMP($J,LIST,+^TMP("DILIST",$J,XX,0),.01)=$P(^TMP("DILIST",$J,XX,0),"^",2)
116 .S ^TMP($J,LIST,"AOI",$P(^TMP("DILIST",$J,XX,0),"^",2),+^TMP("DILIST",$J,XX,0))=""
117 K ^TMP("DILIST",$J)
118 Q
119 ;
120CHK ;
121 N PSS,PSS50,PSSINACT S PSS=0 F S PSS=$O(PSS52P6(52.6,PSS)) Q:'PSS D
122 .S PSS50=$S($G(PSS52P6(52.6,PSS,1,"I"))]"":$G(PSS52P6(52.6,PSS,1,"I")),1:"")
123 .I +$G(PSS50)'>0 S QFLG=1 Q
124 .D GETS^DIQ(50,+PSS50,"100","I","PSSINACT")
125 .S PSS(4)=0 F S PSS(4)=$O(PSSINACT(50,PSS(4))) Q:'PSS(4) D
126 ..S PSSINACT(1)=$G(PSSINACT(50,PSS(4),1,"I")) I PSSINACT(1)'="",(PSSINACT(1)>+$G(PSSFL)) S QFLG=1
127 Q
Note: See TracBrowser for help on using the repository browser.