source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSS51P15.m@ 1306

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1PSS51P15 ;BIR/LDT - API FOR INFORMATION FROM FILE 51.15; 5 Sep 03
2 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
3 ;
4 ;Reference to ^PS(51.15 is supported by DBIA #2132
5 ;
6ALL(PSSIEN,PSSFT,LIST) ;
7 ;PSSIEN - IEN of entry in ADMINISTRATION SHIFT file (#51.15).
8 ;PSSFT - Free Text name in ADMINISTRATION SHIFT file (#51.15).
9 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number
10 ; of the data piece being returned.
11 ;Returns NAME field (#.01), ABBREVIATION field (#1), STANDARD START/STOP TIMES field (#2), PACKAGE field (#4),
12 ;HOSPITAL LOCATION multiple (#51.153), HOSPITAL LOCATION field (#.01), and START/STOP TIMES field (#1)
13 ;of ADMINISTRATION SHIFT file (#51.15).
14 N DIERR,ZZERR,PSS5115,PSS
15 I $G(LIST)']"" Q
16 K ^TMP($J,LIST)
17 I +$G(PSSIEN)'>0,($G(PSSFT)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
18 I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.15,"","A","`"_PSSIEN,,,"") D
19 .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
20 .S ^TMP($J,LIST,0)=1
21 .D GETS^DIQ(51.15,+PSSIEN2,".01;1;2;4;3*","IE","PSS5115") S PSS(1)=0
22 .S PSSIEN=+PSSIEN2 F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO S (CNT,PSS(2))=0 D
23 ..F S PSS(2)=$O(PSS5115(51.153,PSS(2))) Q:'PSS(2) D SETLOC S CNT=CNT+1
24 ..S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
25 I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
26 .I PSSFT["??" D LOOP(1) Q
27 .D FIND^DIC(51.15,,"@;.01;1","QP",PSSFT,,"B",,,"")
28 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
29 .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
30 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS5115 D GETS^DIQ(51.15,+PSSIEN,".01;1;2;4;3*","IE","PSS5115") S PSS(1)=0
31 ..F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO S (CNT,PSS(2))=0 D
32 ...F S PSS(2)=$O(PSS5115(51.153,PSS(2))) Q:'PSS(2) D SETLOC S CNT=CNT+1
33 ...S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
34 K ^TMP("DILIST",$J)
35 Q
36 ;
37ACP(PSSPK,PSSABR,LIST) ;
38 ;PSSPK - PACKAGE field (#4) of ADMINISTRATION SHIFT file (#51.15).
39 ;PSSABR - ABBREVIATION field (#1) of ADMINISTRATION SHIFT file (#51.15).
40 ;LIST - Subscript of ^TMP array in the form ^TMP($J,LIST,Field Number where Field Number is the Field Number
41 ; of the data piece being returned.
42 ;Returns NAME field (#.01), ABBREVIATION field (#1), and PACKAGE field (#4)
43 ;of ADMINISTRATION SHIFT file (#51.15).
44 N DIERR,ZZERR,PSS5115,PSS
45 I $G(LIST)']"" Q
46 K ^TMP($J,LIST)
47 I $G(PSSPK)']""!($G(PSSABR)']"") S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
48 I $G(PSSPK)]"",$G(PSSABR)]"" D
49 .;Naked reference below refers to ^PS(51.15,+Y,0)
50 .S SCR("S")="I $P(^(0),""^"",4)=PSSPK"
51 .D FIND^DIC(51.15,,"@;.01;1","QP",PSSABR,,"C",SCR("S"),,"")
52 .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
53 .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
54 ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K PSS5115 D GETS^DIQ(51.15,+PSSIEN,".01;1;4","IE","PSS5115") S PSS(1)=0
55 ..F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO2
56 K ^TMP("DILIST",$J)
57 Q
58 ;
59SETZRO ;
60 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS5115(51.15,PSS(1),.01,"I"))
61 S ^TMP($J,LIST,"B",$G(PSS5115(51.15,PSS(1),.01,"I")),+PSS(1))=""
62 S ^TMP($J,LIST,+PSS(1),1)=$G(PSS5115(51.15,PSS(1),1,"I"))
63 S ^TMP($J,LIST,+PSS(1),2)=$G(PSS5115(51.15,PSS(1),2,"I"))
64 S ^TMP($J,LIST,+PSS(1),4)=$G(PSS5115(51.15,PSS(1),4,"I"))
65 Q
66 ;
67SETLOC ;
68 S ^TMP($J,LIST,+PSS(1),"HOSP",+PSS(2),.01)=$S($G(PSS5115(51.153,PSS(2),.01,"I"))="":"",1:PSS5115(51.153,PSS(2),.01,"I")_"^"_PSS5115(51.153,PSS(2),.01,"E"))
69 S ^TMP($J,LIST,+PSS(1),"HOSP",+PSS(2),1)=$G(PSS5115(51.153,PSS(2),1,"I"))
70 Q
71 ;
72SETZRO2 ;
73 S ^TMP($J,LIST,+PSS(1),.01)=$G(PSS5115(51.15,PSS(1),.01,"I"))
74 S ^TMP($J,LIST,"ACP",PSSPK,$G(PSS5115(51.15,PSS(1),.01,"I")),+PSS(1))=""
75 S ^TMP($J,LIST,+PSS(1),1)=$G(PSS5115(51.15,PSS(1),1,"I"))
76 S ^TMP($J,LIST,+PSS(1),4)=$G(PSS5115(51.15,PSS(1),4,"I"))
77 Q
78 ;
79LOOP(PSS) ;
80 N CNT,CNT2 S (CNT2,CNT)=0
81 S PSSIEN=0 F S PSSIEN=$O(^PS(51.15,PSSIEN)) Q:'PSSIEN D @(PSS)
82 K ^TMP("DILIST",$J)
83 Q
84 ;
851 ;
86 D GETS^DIQ(51.15,+PSSIEN,".01;1;2;4;3*","IE","PSS5115") S PSS(1)=0
87 F S PSS(1)=$O(PSS5115(51.15,PSS(1))) Q:'PSS(1) D SETZRO S (CNT,PSS(2))=0,CNT2=CNT2+1 D
88 .F S PSS(2)=$O(PSS5115(51.153,PSS(2))) Q:'PSS(2) D SETLOC S CNT=CNT+1
89 .S ^TMP($J,LIST,PSSIEN,"HOSP",0)=$S($G(CNT)>0:CNT,1:"-1^NO DATA FOUND")
90 S ^TMP($J,LIST,0)=$S($G(CNT2)>0:CNT2,1:"-1^NO DATA FOUND")
91 Q
Note: See TracBrowser for help on using the repository browser.