source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS32P3.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PSS32P3 ;BIR/LDT - API FOR INFORMATION FROM FILE 9009032.3; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4ALL(PSSIEN,PSSFT,LIST) ;
5 ;PSSIEN - IEN of entry in 9009032.3.
6 ;PSSFT - Free Text TYPE in 9009032.3.
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 TYPE field (#.01) of APSP INTERVENTION TYPE file (#9009032.3).
10 N DIERR,ZZERR,PSS32P3,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(9009032.3,"","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(9009032.3,+PSSIEN2,".01","I","PSS32P3") S PSS(1)=0
19 .F S PSS(1)=$O(PSS32P3(9009032.3,PSS(1))) Q:'PSS(1) D SETALL
20 I $G(PSSIEN)="",$G(PSSFT)]"" D
21 .I PSSFT["??" D LOOP Q
22 .D FIND^DIC(9009032.3,,"@;.01;","QP",PSSFT,,"B",,,"")
23 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
24 .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
25 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS32P3 D GETS^DIQ(9009032.3,+PSSIEN,".01","I","PSS32P3") S PSS(1)=0
26 ..F S PSS(1)=$O(PSS32P3(9009032.3,PSS(1))) Q:'PSS(1) D SETALL
27 K ^TMP("DILIST",$J)
28 Q
29 ;
30SETALL ;
31 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS32P3(9009032.3,PSS(1),.01,"I"))
32 S ^TMP($J,LIST,"B",$G(PSS32P3(9009032.3,PSS(1),.01,"I")),+PSS(1))=""
33 Q
34 ;
35LOOP ;
36 N PSSIEN
37 S PSSIEN=0 F S PSSIEN=$O(^APSPQA(32.3,PSSIEN)) Q:'PSSIEN D
38 .D GETS^DIQ(9009032.3,+PSSIEN,".01","I","PSS32P3") S PSS(1)=0,^TMP($J,LIST,0)=0 D
39 ..F S PSS(1)=$O(PSS32P3(9009032.3,PSS(1))) Q:'PSS(1) D SETALL S ^TMP($J,LIST,0)=^TMP($J,LIST,0)+1
40 Q
Note: See TracBrowser for help on using the repository browser.