source: FOIAVistA/tag/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50P7A.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1PSS50P7A ;BIR/LDT - API FOR INFORMATION FROM FILE 50.7; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4LOOKUP ;
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
27SETZRO ;
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 ;
42SETZR2 ;
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 ;
48SETSYN ;
49 S ^TMP($J,LIST,+PSSIEN,"SYN",+PSS(1),.01)=$G(PSS50P7(50.72,PSS(1),.01,"I"))
50 Q
51 ;
52SETPTI ;
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 ;
60LOOP(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 ;
671 ;
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 ;
722 ;
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 ;
803 ;
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 ;
854 ;
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 ;
905 ;
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
100SETXSUB ;
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
Note: See TracBrowser for help on using the repository browser.