source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO525AP.m@ 1608

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

initial load of WorldVistAEHR

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