source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS51P5.m@ 1639

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1PSS51P5 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.5; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;External reference to DD(51.5,0,"IX" supported by DBIA 4326
4 ;
5ALL(PSSIEN,PSSFT,PSSCRFL,LIST) ;
6 ;PSSIEN - IEN of entry in the ORDER UNIT file (#51.5).
7 ;PSSFT - Free Text name in the ORDER UNIT file (#51.5).
8 ;PSSCRFL - Multiple index lookup is performed if passed in a 1.
9 ; Otherwise only the "B" cross-reference is used.
10 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
11 ; Field Number of the data piece being returned.
12 ;Returns ABBREVIATION field (#.01) and EXPANSION field (#.02) of ORDER UNIT file (#51.5).
13 N DIERR,ZZERR,PSS51P5,PSS,INDX,PSSISUB,PSSISUBX,PSSLUPP,PSSLUPAR,PSSCNT51
14 S PSSCNT51=0
15 S INDX="B"
16 I $G(LIST)']"" Q
17 K ^TMP($J,LIST)
18 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
19 I $G(PSSIEN)]"",+$G(PSSIEN)'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
20 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.5,"","A","`"_PSSIEN,,,"") D
21 .I +PSSIEN2'>0 Q
22 .S PSSCNT51=PSSCNT51+1
23 .D GETS^DIQ(51.5,+PSSIEN2,".01;.02","I","PSS51P5") S PSS(1)=0
24 .F S PSS(1)=$O(PSS51P5(51.5,PSS(1))) Q:'PSS(1) D SETZRO
25 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
26 .I PSSFT["??" D LOOP Q
27 .I $G(PSSCRFL)=1 S (PSSISUB,PSSISUBX)="" F S PSSISUB=$O(^DD(51.5,0,"IX",PSSISUB)) Q:PSSISUB="" D
28 ..I $G(PSSISUBX)="" S PSSISUBX=PSSISUB Q
29 ..S PSSISUBX=PSSISUBX_"^"_PSSISUB
30 .I $G(PSSCRFL)'=1 S PSSISUBX="B"
31 .K ^TMP($J,"PSSLDONE")
32 .D PARSE(PSSISUBX) I '$O(PSSLUPAR(0)) S PSSLUPAR(1)="B"
33 .S PSSLUPP=0 F S PSSLUPP=$O(PSSLUPAR(PSSLUPP)) Q:'PSSLUPP D
34 ..K ^TMP("DILIST",$J)
35 ..D FIND^DIC(51.5,,"@;.01","QPB"_$S($P(PSSLUPAR(PSSLUPP),"^",2):"X",1:""),PSSFT,,PSSLUPAR(PSSLUPP),,,"")
36 ..I +$G(^TMP("DILIST",$J,0))=0 Q
37 ..N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
38 ...S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) I '$D(^TMP($J,"PSSLDONE",PSSIEN)) S ^TMP($J,"PSSLDONE",PSSIEN)="" K PSS51P5 S PSSCNT51=PSSCNT51+1 D GETS^DIQ(51.5,+PSSIEN,".01;.02","I","PSS51P5") S PSS(1)=0 D
39 ....F S PSS(1)=$O(PSS51P5(51.5,PSS(1))) Q:'PSS(1) D SETZRO
40 S ^TMP($J,LIST,0)=$S($G(PSSCNT51):$G(PSSCNT51),1:"-1^NO DATA FOUND")
41 K ^TMP("DILIST",$J),^TMP($J,"PSSLDONE")
42 Q
43 ;
44EXPAN(PSSEXPAN,LIST) ;
45 ;PSSEXPAN - EXPANSION field (#.02) of the ORDER UNIT file (#51.5).
46 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the
47 ; Field Number of the data piece being returned.
48 ;Returns ABBREVIATION field (#.01) and EXPANSION field (#.02) of ORDER UNIT file (#51.5).
49 N DIERR,ZZERR,PSS51P5,PSS,INDX
50 S INDX="C"
51 I $G(LIST)']"" Q
52 K ^TMP($J,LIST)
53 I $G(PSSEXPAN)']"" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
54 D FIND^DIC(51.5,,"@;.01;.02","QP",PSSEXPAN,,"C",,,"")
55 I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
56 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
57 .S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS51P5 D GETS^DIQ(51.5,+PSSIEN,".01;.02","I","PSS51P5") S PSS(1)=0
58 .F S PSS(1)=$O(PSS51P5(51.5,PSS(1))) Q:'PSS(1) D SETZRO
59 K ^TMP("DILIST",$J)
60 Q
61 ;
62SETZRO ;
63 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS51P5(51.5,PSS(1),.01,"I"))
64 S ^TMP($J,LIST,INDX,$G(PSS51P5(51.5,PSS(1),.01,"I")),+PSS(1))=""
65 S ^TMP($J,LIST,+PSS(1),.02)=$G(PSS51P5(51.5,PSS(1),.02,"I"))
66 Q
67 ;
68LOOP ;
69 N INDX S INDX="B"
70 S PSSIEN=0,^TMP($J,LIST,0)=0 F S PSSIEN=$O(^DIC(51.5,PSSIEN)) Q:'PSSIEN D
71 .S PSSCNT51=PSSCNT51+1
72 .K PSS51P5 D GETS^DIQ(51.5,+PSSIEN,".01;.02","I","PSS51P5") S PSS(1)=0 D
73 ..F S PSS(1)=$O(PSS51P5(51.5,PSS(1))) Q:'PSS(1) D SETZRO
74 K ^TMP("DILIST",$J)
75 Q
76PARSE(PSSLUP) ; Create array of cross references, piece 2 of the array =1 for pointer fields, else 0
77 I $G(PSSLUP)="" Q
78 N PSSLUPA,PSSLUP1,PSSLUP2,PSSLUP3,PSSLUP4,PSSLUP5,PSSDTYPE,PSSPTER
79 I $E(PSSLUP)="^" S PSSLUP=$E(PSSLUP,2,$L(PSSLUP))
80 S PSSLUP1=0 F PSSLUP2=1:1:$L(PSSLUP) I $E(PSSLUP,PSSLUP2)="^" S PSSLUP1=PSSLUP1+1
81 S PSSLUP1=PSSLUP1+1
82 S PSSLUP4=1 F PSSLUP3=1:1:PSSLUP1 S PSSLUP5=$P(PSSLUP,"^",PSSLUP3) I PSSLUP5'="" D S PSSLUPAR(PSSLUP4)=PSSLUP5_"^"_$G(PSSPTER),PSSLUP4=PSSLUP4+1
83 .N PSSCRX,PSSCRX1 S PSSPTER=0
84 .S PSSCRX="" F S PSSCRX=$O(^DD(51.5,0,"IX",PSSLUP5,PSSCRX)) Q:PSSCRX="" S PSSCRX1="" F S PSSCRX1=$O(^DD(51.5,0,"IX",PSSLUP5,PSSCRX,PSSCRX1)) Q:PSSCRX1="" D
85 ..K PSSDTYPE D FIELD^DID(PSSCRX,PSSCRX1,,"TYPE","PSSDTYPE") I $G(PSSDTYPE("TYPE"))="POINTER" S PSSPTER=1
86 Q
Note: See TracBrowser for help on using the repository browser.