source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO5252.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1PSO5252 ;BHAM ISC/SAB- encap II API to return clozapine rx overrides ; 04/07/05 10:30 am
2 ;;7.0;OUTPATIENT PHARMACY;**213**;DEC 1997
3 ;
4EN(LIST,IEN,RX,SDATE,EDATE) ;
5 ;
6 ;LIST: Subscript name used in ^TMP global [REQUIRED]
7 ;IEN: Internal record number [optional]
8 ;RX #: Pointer to Prescription file (#52) [optional]
9 ;SDATE: Starting Date [optional]
10 ;EDATE: Ending Date [optional]
11 ;
12 Q:$G(LIST)=""
13 N DA,DR,PSOPOST,DIC,DIQ K ^TMP($J,LIST)
14 I $G(IEN) D G CLEAN
15 .I $G(^PS(52.52,IEN,0))']"" S ^TMP($J,LIST,IEN,0)="-1^NO DATA FOUND" Q
16 .D PROCESS
17 I $G(RX)]"",'$G(IEN) D G CLEAN
18 .I '$O(^PS(52.52,"A",RX,0)) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
19 .S IEN=$O(^PS(52.52,"A",RX,0))
20 .I $G(^PS(52.52,IEN,0))']"" S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
21 .D PROCESS
22 I $G(SDATE)!($G(EDATE)) D DATE G CLEAN
23 F IEN=0:0 S IEN=$O(^PS(52.52,IEN)) Q:'IEN D PROCESS
24CLEAN I '$O(^TMP($J,LIST,0)) S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
25 K DA,DR,DIC,PSOPOST,DIQ,LDATE
26 Q
27PROCESS ;
28 K PSOPOST S DIC=52.52,DA=IEN,DR=".01:5",DIQ="PSOPOST",DIQ(0)="IE" D EN^DIQ1
29 F DR=.01,1,2,3,4,5 D
30 .I DR=.01 S ^TMP($J,LIST,"B",PSOPOST(52.52,DA,DR,"I"),IEN)="",^TMP($J,LIST,0)=$G(^TMP($J,LIST,0))+1
31 .I PSOPOST(52.52,DA,DR,"E")'=PSOPOST(52.52,DA,DR,"I") S ^TMP($J,LIST,IEN,DR)=PSOPOST(52.52,DA,DR,"I")_"^"_PSOPOST(52.52,DA,DR,"E") Q
32 .S ^TMP($J,LIST,IEN,DR)=PSOPOST(52.52,DA,DR,"I")
33 K DA,DR,PSOPOST,DIC,DIQ
34 Q
35DATE ;date range
36 I $G(SDATE) S LDATE=$P(SDATE,".") D Q
37 .I $G(EDATE) S EDATE=EDATE_".9999999" F S LDATE=$O(^PS(52.52,"B",LDATE)) Q:'LDATE!(LDATE>EDATE) F IEN=0:0 S IEN=$O(^PS(52.52,"B",LDATE,IEN)) Q:'IEN D PROCESS
38 .I '$G(EDATE) F S LDATE=$O(^PS(52.52,"B",LDATE)) Q:'LDATE F IEN=0:0 S IEN=$O(^PS(52.52,"B",LDATE,IEN)) Q:'IEN D PROCESS
39 I $G(EDATE),'$G(SDATE) S EDATE=EDATE_".9999999" D Q
40 .F LDATE=0:0 S LDATE=$O(^PS(52.52,"B",LDATE)) Q:'LDATE!(LDATE>EDATE) F IEN=0:0 S IEN=$O(^PS(52.52,"B",LDATE,IEN)) Q:'IEN D PROCESS
41 Q
Note: See TracBrowser for help on using the repository browser.