1 | PSS50P7A ;BIR/LDT - API FOR INFORMATION FROM FILE 50.7; 5 Sep 03
|
---|
2 | ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
|
---|
3 | ;
|
---|
4 | LOOKUP ;
|
---|
5 | N PSSSCRN,PSSLUPAR,PSSLUPP,PSSLKIEN,PSSCT507,PSSXSUB
|
---|
6 | S SCR("S")=$S($G(PSSS)]"":PSSS,1:"")
|
---|
7 | S PSSCT507=0
|
---|
8 | I PSSFT["??" D LOOP^PSS50P7A(5) Q
|
---|
9 | S PSSXSUB="" D SETXSUB
|
---|
10 | K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
|
---|
11 | S PSSSCRN=$G(SCR("S")) S:$G(PSSD)="" PSSD="B" D PARSE^PSS50F(PSSD) I '$O(PSSLUPAR(0)) S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
|
---|
12 | S PSSLUPP=0 F S PSSLUPP=$O(PSSLUPAR(PSSLUPP)) Q:'PSSLUPP D
|
---|
13 | .S SCR("S")=$G(PSSSCRN)
|
---|
14 | .D FIND^DIC(50.7,,"@;.01;.02IE;.04IE","QPB"_$S($P(PSSLUPAR(PSSLUPP),"^",2):"X",1:""),PSSFT,,PSSLUPAR(PSSLUPP),SCR("S"),,"")
|
---|
15 | .I +$G(^TMP("DILIST",$J,0))'>0 Q
|
---|
16 | .S PSS(2)=0
|
---|
17 | .F S PSS(2)=$O(^TMP("DILIST",$J,PSS(2))) Q:'PSS(2) D
|
---|
18 | ..S PSSLKIEN=$P($G(^TMP("DILIST",$J,PSS(2),0)),"^") I '$D(^TMP($J,"PSSLDONE",PSSLKIEN)) S ^TMP($J,"PSSLDONE",PSSLKIEN)="" D
|
---|
19 | ...S PSSCT507=PSSCT507+1
|
---|
20 | ...S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.01)=$P(^TMP("DILIST",$J,PSS(2),0),"^",2)
|
---|
21 | ...S ^TMP($J,LIST,$S($G(PSSXSUB)'="":$G(PSSXSUB),1:"B"),$P(^TMP("DILIST",$J,PSS(2),0),"^",2),+^TMP("DILIST",$J,PSS(2),0))=""
|
---|
22 | ...S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.02)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",3)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",3,4),1:"")
|
---|
23 | ...S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.04)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",5)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",5,6),1:"")
|
---|
24 | S ^TMP($J,LIST,0)=$S(PSSCT507>0:PSSCT507,1:"-1^NO DATA FOUND")
|
---|
25 | K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
|
---|
26 | Q
|
---|
27 | SETZRO ;
|
---|
28 | S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS50P7(50.7,PSS(1),.01,"I"))
|
---|
29 | S ^TMP($J,LIST,"B",$G(PSS50P7(50.7,PSS(1),.01,"I")),+PSS(1))=""
|
---|
30 | S ^TMP($J,LIST,+PSS(1),.02)=$S($G(PSS50P7(50.7,PSS(1),.02,"I"))="":"",1:PSS50P7(50.7,PSS(1),.02,"I")_"^"_PSS50P7(50.7,PSS(1),.02,"E"))
|
---|
31 | S ^TMP($J,LIST,+PSS(1),.03)=$S($G(PSS50P7(50.7,PSS(1),.03,"I"))="":"",1:PSS50P7(50.7,PSS(1),.03,"I")_"^"_PSS50P7(50.7,PSS(1),.03,"E"))
|
---|
32 | S ^TMP($J,LIST,+PSS(1),.04)=$S($G(PSS50P7(50.7,PSS(1),.04,"I"))="":"",1:PSS50P7(50.7,PSS(1),.04,"I")_"^"_PSS50P7(50.7,PSS(1),.04,"E"))
|
---|
33 | S ^TMP($J,LIST,+PSS(1),.05)=$G(PSS50P7(50.7,PSS(1),.05,"I"))
|
---|
34 | S ^TMP($J,LIST,+PSS(1),.06)=$S($G(PSS50P7(50.7,PSS(1),.06,"I"))="":"",1:PSS50P7(50.7,PSS(1),.06,"I")_"^"_PSS50P7(50.7,PSS(1),.06,"E"))
|
---|
35 | S ^TMP($J,LIST,+PSS(1),.07)=$S($G(PSS50P7(50.7,PSS(1),.07,"I"))="":"",1:PSS50P7(50.7,PSS(1),.07,"I")_"^"_PSS50P7(50.7,PSS(1),.07,"E"))
|
---|
36 | S ^TMP($J,LIST,+PSS(1),.08)=$G(PSS50P7(50.7,PSS(1),.08,"I"))
|
---|
37 | S ^TMP($J,LIST,+PSS(1),.09)=$S($G(PSS50P7(50.7,PSS(1),.09,"I"))="":"",1:PSS50P7(50.7,PSS(1),.09,"I")_"^"_PSS50P7(50.7,PSS(1),.09,"E"))
|
---|
38 | S ^TMP($J,LIST,+PSS(1),8)=$S($G(PSS50P7(50.7,PSS(1),8,"I"))="":"",1:PSS50P7(50.7,PSS(1),8,"I")_"^"_PSS50P7(50.7,PSS(1),8,"E"))
|
---|
39 | S ^TMP($J,LIST,+PSS(1),5)=$S($G(PSS50P7(50.7,PSS(1),5,"I"))="":"",1:PSS50P7(50.7,PSS(1),5,"I")_"^"_PSS50P7(50.7,PSS(1),5,"E"))
|
---|
40 | Q
|
---|
41 | ;
|
---|
42 | SETZR2 ;
|
---|
43 | S ^TMP($J,LIST,+PSS(2),.01)=$G(PSS50P7(50.7,PSS(2),.01,"I"))
|
---|
44 | S ^TMP($J,LIST,"B",$G(PSS50P7(50.7,PSS(2),.01,"I")),+PSS(2))=""
|
---|
45 | S ^TMP($J,LIST,+PSS(2),.02)=$S($G(PSS50P7(50.7,PSS(2),.02,"I"))="":"",1:PSS50P7(50.7,PSS(2),.02,"I")_"^"_PSS50P7(50.7,PSS(2),.02,"E"))
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | SETSYN ;
|
---|
49 | S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(1),.01)=$G(PSS50P7(50.72,PSS(1),.01,"I"))
|
---|
50 | Q
|
---|
51 | ;
|
---|
52 | SETPTI ;
|
---|
53 | S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS50P7(50.7,PSS(1),.01,"I"))
|
---|
54 | S ^TMP($J,LIST,"B",$G(PSS50P7(50.7,PSS(1),.01,"I")),+PSS(1))=""
|
---|
55 | S ^TMP($J,LIST,+PSS(1),.02)=$S($G(PSS50P7(50.7,PSS(1),.02,"I"))="":"",1:PSS50P7(50.7,PSS(1),.02,"I")_"^"_PSS50P7(50.7,PSS(1),.02,"E"))
|
---|
56 | S ^TMP($J,LIST,+PSS(1),7)=$G(PSS50P7(50.7,PSS(1),7,"I"))
|
---|
57 | S ^TMP($J,LIST,+PSS(1),7.1)=$G(PSS50P7(50.7,PSS(1),7.1,"I"))
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | LOOP(PSS) ;
|
---|
61 | N CNT,PSSIEN S CNT=0
|
---|
62 | S PSSIEN=0 F S PSSIEN=$O(^PS(50.7,PSSIEN)) Q:'PSSIEN D
|
---|
63 | .S ND=$P($G(^PS(50.7,+PSSIEN,0)),U,4) I ND=""!ND>$G(PSSFL) D @(PSS)
|
---|
64 | S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
|
---|
65 | Q
|
---|
66 | ;
|
---|
67 | 1 ;
|
---|
68 | K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;.03;.04;.05;.06;.07;.08;.09;8;5","IE","PSS50P7") S PSS(1)=0
|
---|
69 | F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETZRO^PSS50P7A S CNT=CNT+1
|
---|
70 | Q
|
---|
71 | ;
|
---|
72 | 2 ;
|
---|
73 | N CNT2 S CNT2=0
|
---|
74 | K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;2*","IE","PSS50P7") S PSS(1)=0
|
---|
75 | F S PSS(1)=$O(PSS50P7(50.72,PSS(1))) Q:'PSS(1) D SETSYN^PSS50P7A S CNT2=CNT2+1
|
---|
76 | S PSS(2)=0 F S PSS(2)=$O(PSS50P7(50.7,PSS(2))) Q:'PSS(2) D SETZR2^PSS50P7A S CNT=CNT+1
|
---|
77 | S ^TMP($J,LIST,+PSSIEN,"SYN",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | 3 ;
|
---|
81 | K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02;7;7.1","IE","PSS50P7") S PSS(1)=0
|
---|
82 | F S PSS(1)=$O(PSS50P7(50.7,PSS(1))) Q:'PSS(1) D SETPTI^PSS50P7A S CNT=CNT+1
|
---|
83 | Q
|
---|
84 | ;
|
---|
85 | 4 ;
|
---|
86 | K PSS50P7 D GETS^DIQ(50.7,+PSSIEN,".01;.02","IE","PSS50P7") S PSS(2)=0
|
---|
87 | F S PSS(2)=$O(PSS50P7(50.7,PSS(2))) Q:'PSS(2) D SETZR2^PSS50P7A S CNT=CNT+1
|
---|
88 | Q
|
---|
89 | ;
|
---|
90 | 5 ;
|
---|
91 | D FIND^DIC(50.7,,"@;.01;.02IE;.04IE","QP","`"_+PSSIEN,,"B",SCR("S"),,"")
|
---|
92 | S CNT=CNT+1,^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) S PSS(2)=0 D
|
---|
93 | .F S PSS(2)=$O(^TMP("DILIST",$J,PSS(2))) Q:'PSS(2) D
|
---|
94 | ..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.01)=$P(^TMP("DILIST",$J,PSS(2),0),"^",2)
|
---|
95 | ..S ^TMP($J,LIST,"B",$P(^TMP("DILIST",$J,PSS(2),0),"^",2),+^TMP("DILIST",$J,PSS(2),0))=""
|
---|
96 | ..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.02)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",3)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",3,4),1:"")
|
---|
97 | ..S ^TMP($J,LIST,+^TMP("DILIST",$J,PSS(2),0),.04)=$S($P($G(^TMP("DILIST",$J,PSS(2),0)),"^",5)]"":$P(^TMP("DILIST",$J,PSS(2),0),"^",5,6),1:"")
|
---|
98 | K ^TMP("DILIST",$J)
|
---|
99 | Q
|
---|
100 | SETXSUB ;
|
---|
101 | Q:$G(PSSD)=""
|
---|
102 | N PSSLSX,PSSLSXCT,PSSLCNT,PSSDSUB
|
---|
103 | S PSSLSXCT=0
|
---|
104 | F PSSLSX=1:1:$L(PSSD) I $E(PSSD,PSSLSX)="^" S PSSLSXCT=PSSLSXCT+1
|
---|
105 | S PSSLSXCT=PSSLSXCT+1
|
---|
106 | S PSSLCNT=0 F PSSLSX=1:1:PSSLSXCT S PSSDSUB=$P(PSSD,"^",PSSLSX) Q:PSSLCNT>1 S PSSXSUB=$S(PSSDSUB'="":PSSDSUB,PSSXSUB'="":PSSXSUB,1:"") S:PSSDSUB'="" PSSLCNT=PSSLCNT+1
|
---|
107 | I PSSLCNT>1 S PSSXSUB=""
|
---|
108 | Q
|
---|