source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS54.m@ 1773

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1PSS54 ;BIR/LDT - API FOR INFORMATION FROM FILE 54; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4ALL(PSSIEN,PSSFT,LIST) ;
5 ;PSSIEN - IEN of entry in RX CONSULT file (#54).
6 ;PSSFT - Free Text name in RX CONSULT file (#54).
7 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
8 ; Field Number of the data piece being returned.
9 ;Returns NAME field (#.01) and TEXT field (#1) of RX CONSULT file (#54).
10 N DIERR,ZZERR,PSS54,PSS
11 I $G(LIST)']"" Q
12 K ^TMP($J,LIST)
13 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
14 I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
15 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(54,"","A","`"_PSSIEN,,,"") D
16 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
17 .S ^TMP($J,LIST,0)=1
18 .D GETS^DIQ(54,+PSSIEN2,".01;1*","I","PSS54") S PSS(1)=0
19 .F S PSS(1)=$O(PSS54(54,PSS(1))) Q:'PSS(1) D SETZRO S PSS(2)=0,^TMP($J,LIST,+PSSIEN,"TXT",0)=0 D
20 ..F S PSS(2)=$O(PSS54(54.1,PSS(2))) Q:'PSS(2) S ^TMP($J,LIST,+PSSIEN,"TXT",0)=^TMP($J,LIST,+PSSIEN,"TXT",0)+1 D SETTXT
21 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
22 .I PSSFT["??" D LOOP Q
23 .D FIND^DIC(54,,"@;.01","QP",PSSFT,,"B",,,"")
24 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
25 .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
26 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS54 D GETS^DIQ(54,+PSSIEN,".01;1*","I","PSS54") S PSS(1)=0
27 ..F S PSS(1)=$O(PSS54(54,PSS(1))) Q:'PSS(1) D SETZRO S PSS(2)=0,^TMP($J,LIST,+PSSIEN,"TXT",0)=0 D
28 ...F S PSS(2)=$O(PSS54(54.1,PSS(2))) Q:'PSS(2) S ^TMP($J,LIST,+PSSIEN,"TXT",0)=^TMP($J,LIST,+PSSIEN,"TXT",0)+1 D SETTXT
29 K ^TMP("DILIST",$J)
30 Q
31 ;
32LOOKUP(PSSSRCH,LIST) ;
33 ;PSSSRCH - IEN of entry in RX CONSULT file (#54).
34 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
35 ; Field Number of the data piece being returned.
36 ;Returns NAME field (#.01) of RX CONSULT file (#54).
37 N DIERR,ZZERR
38 I $G(LIST)']"" Q
39 K ^TMP($J,LIST)
40 I $G(PSSSRCH)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
41 D FIND^DIC(54,,"@;.01;","QP",PSSSRCH,,"B",,,"")
42 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
43 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
44 .S ^TMP($J,LIST,+^TMP("DILIST",$J,PSSXX,0),.01)=$P($G(^TMP("DILIST",$J,PSSXX,0)),U,2)
45 .S ^TMP($J,LIST,"B",$P($G(^TMP("DILIST",$J,PSSXX,0)),U,2),+^TMP("DILIST",$J,PSSXX,0))=""
46 K ^TMP("DILIST",$J)
47 Q
48 ;
49SETZRO ;
50 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS54(54,PSS(1),.01,"I"))
51 S ^TMP($J,LIST,"B",$G(PSS54(54,PSS(1),.01,"I")),+PSS(1))=""
52 Q
53 ;
54SETTXT ;
55 S ^TMP($J,LIST,+PSSIEN,"TXT",+PSS(2),.01)=$G(PSS54(54.1,PSS(2),.01,"I"))
56 Q
57 ;
58LOOP ;
59 N PSSIEN,CNT
60 S (PSSIEN,CNT)=0 F S PSSIEN=$O(^PS(54,PSSIEN)) Q:'PSSIEN D
61 .K PSS54 D GETS^DIQ(54,+PSSIEN,".01;1*","I","PSS54") S PSS(1)=0,CNT=CNT+1
62 .F S PSS(1)=$O(PSS54(54,PSS(1))) Q:'PSS(1) D SETZRO S PSS(2)=0,^TMP($J,LIST,+PSSIEN,"TXT",0)=0 D
63 ..F S PSS(2)=$O(PSS54(54.1,PSS(2))) Q:'PSS(2) S ^TMP($J,LIST,+PSSIEN,"TXT",0)=^TMP($J,LIST,+PSSIEN,"TXT",0)+1 D SETTXT
64 S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
65 Q
Note: See TracBrowser for help on using the repository browser.