source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO5291.m@ 1087

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1PSO5291 ;BHM/DB - TPB Eligibility file API ; 18 JUL 05
2 ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997
3PSO(PSOIEN,PSOTXT,LIST) ;SDD 3.2.21
4 ;PSOIEN - IEN
5 ;PSOTXT - FREE TEXT ENTRY
6 Q:$G(LIST)=""
7 N DA,DIC,DR,DIQ,X K ^TMP($J,LIST),^UTILITY("DIQ1",$J)
8 I $G(PSOIEN)="",$G(PSOTXT)="" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
9 I $G(PSOIEN)]"" D G Q
10 .I '$G(^PS(52.91,PSOIEN,0)) S ^TMP($J,LIST,PSOIEN,0)="-1^NO DATA FOUND" Q
11 .S DA=PSOIEN D TMP
12 I $G(PSOTXT)]"" D G Q
13 .S DA=$O(^DPT("B",PSOTXT,0)) I DA="" S ^TMP($J,LIST,PSOTXT,0)="-1^NO DATA FOUND" Q
14 .D TMP
15 Q
16TMP S ^TMP($J,LIST,DA,0)=1
17 S DIC=52.91,DR=".01:11",DIQ(0)="IE"
18 D EN^DIQ1 I '$D(^UTILITY("DIQ1",$J)) S ^TMP($J,LIST,DA,0)="-1^NO DATA FOUND" Q
19 F X=.01,1,2,3,4,5,6,7,8,9,10,11 D
20 .S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,52.91,DA,X,"I"))
21 .S ^TMP($J,LIST,DA,X)=$S($G(^UTILITY("DIQ1",$J,52.91,DA,X,"E"))'="":^TMP($J,LIST,DA,X)_"^"_$G(^UTILITY("DIQ1",$J,52.91,DA,X,"E")),1:"")
22 S DFN=$G(^UTILITY("DIQ1",$J,52.91,DA,.01,"I")),^TMP($J,LIST,"B",DFN,DA)=""
23 K ^UTILITY("DIQ1",$J)
24 Q
25Q K DA,DFN,DIC,DIQ,DR,LIST,PSOIEN,PSOTXT,X Q
Note: See TracBrowser for help on using the repository browser.