source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS50LAB.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: 4.4 KB
Line 
1PSS50LAB ;BIR/LDT - API FOR LAB INFORMATION FROM FILE 50; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4LAB ;
5 ;PSSIEN - IEN of entry in 50
6 ;PSSFT - Free Text name in 50
7 ;PSSFL - Inactive flag - "" - All entries
8 ; FileMan Date - Only entries with no Inactive Date or an Inactive Date greater than this date.
9 ;PSSPK - Application Package's Use - "" - All entries
10 ; Alphabetic codes that represent the DHCP packages that consider this drug to be
11 ; part of their formulary.
12 ;PSSRTOI - Orderable Item - return only entries matched to a Pharmacy Orderable Item
13 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number of the data
14 ; piece being returned.
15 N DIERR,ZZERR,PSSP50,SCR,PSS,PSSMLCT
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 S SCR("S")=""
20 I +$G(PSSFL)>0!($G(PSSPK)]"")!($G(PSSRTOI)=1) N PSS5ND,PSSZ3,PSSZ4 D SETSCRN^PSS50A
21 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(50,"","A","`"_PSSIEN,,SCR("S"),"") D K ^TMP("PSSP50",$J) Q
22 .K ^TMP("DIERR",$J)
23 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
24 .S ^TMP($J,LIST,0)=1
25 .K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN2,".01;17.2:17.6","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
26 .F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETLAB
27 I $G(PSSIEN)'="" S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
28 I $G(PSSFT)]"" D
29 .I PSSFT["??" D LOOP Q
30 .K ^TMP("DILIST",$J)
31 .D FIND^DIC(50,,"@;.01","QP",PSSFT,,"B",SCR("S"),,"")
32 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
33 .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
34 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0)
35 ..K ^TMP("PSSP50",$J) D GETS^DIQ(50,+PSSIEN,".01;17.2:17.6","IE","^TMP(""PSSP50"",$J)") S PSS(1)=0
36 ..F S PSS(1)=$O(^TMP("PSSP50",$J,50,PSS(1))) Q:'PSS(1) D SETLAB
37 K ^TMP("DILIST",$J),^TMP("PSSP50",$J)
38 Q
39 ;
40SETLAB ;
41 S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I"))
42 S ^TMP($J,LIST,"B",$G(^TMP("PSSP50",$J,50,PSS(1),.01,"I")),+PSS(1))=""
43 S ^TMP($J,LIST,+PSS(1),17.2)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.2,"E")))
44 S ^TMP($J,LIST,+PSS(1),17.3)=$G(^TMP("PSSP50",$J,50,PSS(1),17.3,"I"))
45 S ^TMP($J,LIST,+PSS(1),17.4)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.4,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.4,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.4,"E")))
46 S ^TMP($J,LIST,+PSS(1),17.5)=$G(^TMP("PSSP50",$J,50,PSS(1),17.5,"I"))
47 S ^TMP($J,LIST,+PSS(1),17.6)=$S($G(^TMP("PSSP50",$J,50,PSS(1),17.6,"I"))="":"",1:$G(^TMP("PSSP50",$J,50,PSS(1),17.6,"I"))_"^"_$G(^TMP("PSSP50",$J,50,PSS(1),17.6,"E")))
48 Q
49 ;
50LOOP ;
51 N PSS50D12,PSS50E12,PSS176D D FIELD^DID(50,17.6,"Z","POINTER","PSS50D12","PSS50E12") S PSS176D=$G(PSS50D12("POINTER"))
52 N PSSENCT
53 S PSSENCT=0
54 S PSS(1)=0 F S PSS(1)=$O(^PSDRUG(PSS(1))) Q:'PSS(1) D
55 .I $P($G(^PSDRUG(PSS(1),0)),"^")="" Q
56 .I $G(PSSFL),$P($G(^PSDRUG(PSS(1),"I")),"^"),$P($G(^("I")),"^")'>PSSFL Q
57 .I $G(PSSRTOI)=1,'$P($G(^PSDRUG(PSS(1),2)),"^") Q
58 .;Naked reference below refers to ^PSDRUG(PSS(1),2)
59 .I $G(PSSPK)]"" N PSSZ5,PSSZ6 S PSSZ5=0 F PSSZ6=1:1:$L(PSSPK) Q:PSSZ5 I $P($G(^(2)),"^",3)[$E(PSSPK,PSSZ6) S PSSZ5=1
60 .I $G(PSSPK)]"",'PSSZ5 Q
61 .D SETLABL
62 .S PSSENCT=PSSENCT+1
63 S ^TMP($J,LIST,0)=$S($G(PSSENCT):$G(PSSENCT),1:"-1^NO DATA FOUND")
64 Q
65SETLABL ;
66 N PSSZNODE,PSS50CL,PSS50CL1
67 S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS50CL=$G(^("CLOZ")),PSS50CL1=$G(^("CLOZ1"))
68 S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
69 S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
70 N PSSCLZAR D GETS^DIQ(50,+PSS(1),"17.2;17.4","IE","PSSCLZAR")
71 S ^TMP($J,LIST,+PSS(1),17.2)=$S($G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))="":"",1:$G(PSSCLZAR(50,+PSS(1)_",",17.2,"I"))_"^"_$G(PSSCLZAR(50,+PSS(1)_",",17.2,"E")))
72 S ^TMP($J,LIST,+PSS(1),17.3)=$P(PSS50CL,"^",2)
73 S ^TMP($J,LIST,+PSS(1),17.4)=$S($G(PSSCLZAR(50,+PSS(1)_",",17.4,"I"))="":"",1:$G(PSSCLZAR(50,+PSS(1)_",",17.4,"I"))_"^"_$G(PSSCLZAR(50,+PSS(1)_",",17.4,"E")))
74 S ^TMP($J,LIST,+PSS(1),17.5)=$P(PSS50CL1,"^")
75 N PSS176 S PSS176=$P(PSS50CL1,"^",2) D
76 .I PSS176'="",PSS176D'="",PSS176D[(PSS176_":") S ^TMP($J,LIST,+PSS(1),17.6)=PSS176_"^"_$P($E(PSS176D,$F(PSS176D,(PSS176_":")),999),";") Q
77 .S ^TMP($J,LIST,+PSS(1),17.6)=""
78 Q
Note: See TracBrowser for help on using the repository browser.