| 1 | PSO52AP1 ;BHM/SAB - Encapsulation II API to return Rx data ;04/07/05 10:30 am
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**213,245**;DEC 1997;Build 20
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^PS(55 supported by DBIA 2228
|
|---|
| 5 | ;Reference to ^PSDRUG supported by DBIA 221
|
|---|
| 6 | ;
|
|---|
| 7 | ;Rx profile called from PROF^PSO52API
|
|---|
| 8 | ;DFN: Patient's IEN
|
|---|
| 9 | ;LIST: Subscript name used in ^TMP global [REQUIRED]
|
|---|
| 10 | ;SDATE: Starting Expiration Date [optional]
|
|---|
| 11 | ;EDATE: Ending Expiration Date [optional]
|
|---|
| 12 | ;
|
|---|
| 13 | Q:$G(LIST)=""
|
|---|
| 14 | N DA,DR,PST,DIC,DIQ,DATE,IEN K ^TMP($J,LIST)
|
|---|
| 15 | Q:'$G(DFN)
|
|---|
| 16 | I '$O(^PS(55,DFN,"P",0)),$O(^PS(55,DFN,"ARC",0)) S ^TMP($J,LIST,DFN,"ARC",0)="PATIENT HAS ARCHIVED PRESCRIPTIONS"
|
|---|
| 17 | I $G(SDATE) S DATE=SDATE-1 D G EX
|
|---|
| 18 | .I $G(EDATE) F S DATE=$O(^PS(55,DFN,"P","A",DATE)) Q:'DATE!(DATE>EDATE) F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DATE,IEN)) Q:'IEN D ND
|
|---|
| 19 | .I '$G(EDATE) F S DATE=$O(^PS(55,DFN,"P","A",DATE)) Q:'DATE F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DATE,IEN)) Q:'IEN D ND
|
|---|
| 20 | I $G(EDATE),'$G(SDATE) S DATE=DT-1 D G EX
|
|---|
| 21 | .F S DATE=$O(^PS(55,DFN,"P","A",DATE)) Q:'DATE!(DATE>EDATE) F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DATE,IEN)) Q:'IEN D ND
|
|---|
| 22 | S DATE=DT-1 F S DATE=$O(^PS(55,DFN,"P","A",DATE)) Q:'DATE F IEN=0:0 S IEN=$O(^PS(55,DFN,"P","A",DATE,IEN)) Q:'IEN D ND
|
|---|
| 23 | EX I $G(DFN),$G(LIST)]"",'$O(^TMP($J,LIST,DFN,0)) S ^TMP($J,LIST,DFN,0)="-1^NO PRESCRIPTION DATA FOUND"
|
|---|
| 24 | Q
|
|---|
| 25 | ND ;returns data
|
|---|
| 26 | I DFN'=$P($G(^PSRX(IEN,0)),"^",2) Q
|
|---|
| 27 | I $G(^PSRX(IEN,0))']"" Q
|
|---|
| 28 | Q:$P($G(^PSRX(IEN,"STA")),"^")=13
|
|---|
| 29 | S ^TMP($J,LIST,DFN,0)=$G(^TMP($J,LIST,DFN,0))+1
|
|---|
| 30 | I DT>$P(^PSRX(IEN,2),"^",6),$P(^PSRX(IEN,"STA"),"^")<11 D
|
|---|
| 31 | .N PSOEXRX,PSOEXSTA,ORN,PIFN,PSUSD,PRFDT,PDA,PSDTEST
|
|---|
| 32 | .S PSOEXRX=IEN D EN2^PSOMAUEX K PSOEXRX,PSONM,PSONMX
|
|---|
| 33 | K PST S DIC=52,DA=IEN,DR=".01:9;10.3;10.6;11;16;17;100"
|
|---|
| 34 | S DIQ="PST",DIQ(0)="IE" D EN^DIQ1
|
|---|
| 35 | S ^TMP($J,LIST,"B",PST(52,DA,.01,"E"),IEN)=""
|
|---|
| 36 | F DR=.01,1,2,3,4,5,6,6.5,7,8,9,10.3,10.6,11,16,17,100 D
|
|---|
| 37 | .I PST(52,DA,DR,"E")'=PST(52,DA,DR,"I") S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")_"^"_PST(52,DA,DR,"E") Q
|
|---|
| 38 | .S ^TMP($J,LIST,DFN,IEN,DR)=PST(52,DA,DR,"I")
|
|---|
| 39 | S $P(^TMP($J,LIST,DFN,IEN,.01),U,2)=IEN
|
|---|
| 40 | K DA,DR,PST,DIC,DIQ
|
|---|
| 41 | Q
|
|---|
