1 | PSX550 ;BIR/DB - API for file 550 ;24 Feb 2006
|
---|
2 | ;;2.0;CMOP;**61**;11 Apr 97;Build 1
|
---|
3 | PSX(PSXIEN,PSXTXT,LIST) ;
|
---|
4 | ;PSXIEN -CMOP system internal entry number (optional)
|
---|
5 | ;PSXTXT - Free Text CMOP system name (optional)
|
---|
6 | ;LIST: Subscript name used in ^TMP global [REQUIRED]
|
---|
7 | I $G(PSXIEN)="",$G(PSXTXT)="" Q
|
---|
8 | I $G(LIST)="" Q
|
---|
9 | K ^TMP($J,LIST),DA,^UTILITY("DIQ1",$J),DIQ
|
---|
10 | I $G(PSXIEN)]"" S DA=PSXIEN I '$D(^PSX(550,DA,0)) G RET0
|
---|
11 | I $G(PSXTXT)'="",$G(PSXIEN)'>0,'$D(^PSX(550,"B",PSXTXT)) G RET0
|
---|
12 | I $G(PSXTXT)'="",$G(DA)'>0 S DA=$O(^PSX(550,"B",PSXTXT,0))
|
---|
13 | K ^UTILITY("DIQ1",$J),DIC S DIC=550,DR=".01;1",DIQ(0)="IE" D EN^DIQ1
|
---|
14 | I '$D(^UTILITY("DIQ1",$J)) G RET0
|
---|
15 | S:$G(PSXTXT)="" PSXTXT=^UTILITY("DIQ1",$J,550,DA,.01,"E")
|
---|
16 | S ^TMP($J,LIST,1)=$G(^UTILITY("DIQ1",$J,550,DA,1,"I"))
|
---|
17 | S ^TMP($J,LIST,1)=$S($G(^UTILITY("DIQ1",$J,550,DA,1,"E"))'="":^TMP($J,LIST,1)_"^"_$G(^UTILITY("DIQ1",$J,550,DA,1,"E")),1:"")
|
---|
18 | S ^TMP($J,LIST,"B",PSXTXT,DA)=""
|
---|
19 | Q
|
---|
20 | K PSXIEN,DA,X,PSXTXT,DR,DIC Q
|
---|
21 | RET0 ;return no data
|
---|
22 | S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
|
---|
23 | Q
|
---|