Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSO52EX

PSO52EX.m

Go to the documentation of this file.
  1. PSO52EX ;BHAM ISC/AGV - API FOR ORIGINAL, REFILL, AND PARTIAL DATA ;06/03/16 17:07
  1. ;;7.0;OUTPATIENT PHARMACY;**252,267,441**;DEC 1997;Build 208
  1. ;
  1. ;REFERENCE TO ^DPT SUPPORTED BY DBIA 10035
  1. ;REFERENCE TO ^PSDRUG SUPPORTED BY DBIA 221
  1. ;
  1. ;
  1. EXTRACT(SDATE,EDATE,LIST) ;MAIN DRIVER
  1. ;SDATE: START DATE OF RECORD RETRIEVAL [REQUIRED]
  1. ;EDATE: END DATE OF RECORD RETRIEVAL [OPTIONAL]
  1. ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
  1. ;
  1. Q:$G(LIST)=""
  1. K ^TMP($J,LIST)
  1. I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
  1. I '$G(EDATE) S EDATE=DT
  1. D SEND
  1. Q
  1. ;
  1. SEND ;SENDS CONTROL TO $$CROSS. RECEIVES AND TRACKS COUNTS.
  1. N ALCOUNT S ALCOUNT=$$CROSS("AL")
  1. N AMCOUNT S AMCOUNT=$$CROSS("AM")
  1. N TCOUNT S TCOUNT=ALCOUNT+AMCOUNT
  1. IF TCOUNT>0 S ^TMP($J,LIST,0)=TCOUNT
  1. ELSE S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
  1. Q
  1. ;
  1. CROSS(REF) ;SETS UP ^TMP GLOBAL. SENDS FOR ORIGINAL, REFILL AND/OR PARTIAL FILL DATA
  1. N PSOIEN,PSOFILL,PSOCOUNT,DATE,END
  1. S DATE=SDATE-.001,END=(EDATE+1),PSOIEN="",PSOFILL="",PSOCOUNT=0
  1. F S DATE=$O(^PSRX(REF,DATE)) Q:'DATE!(END'>DATE) D
  1. .F S PSOIEN=$O(^PSRX(REF,DATE,PSOIEN)) Q:'PSOIEN D
  1. ..F S PSOFILL=$O(^PSRX(REF,DATE,PSOIEN,PSOFILL)) Q:PSOFILL="" D
  1. ...S ^TMP($J,LIST,REF,DATE,PSOIEN,PSOFILL)=""
  1. ...I REF="AL",PSOFILL=0 S PSOCOUNT=PSOCOUNT+1 D ORIG(PSOIEN) Q
  1. ...I REF="AL",PSOFILL>0 S PSOCOUNT=PSOCOUNT+1 D REFILL(PSOIEN,PSOFILL) Q
  1. ...I REF="AM" S PSOCOUNT=PSOCOUNT+1 D PART(PSOIEN,PSOFILL) Q
  1. Q PSOCOUNT
  1. ;
  1. REFILL(IEN,FILL) ;REFILL
  1. D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
  1. N PSORFL S PSORFL=$G(^PSRX(IEN,1,FILL,0))
  1. S ^TMP($J,LIST,IEN,"RF",FILL,.01)=$P(PSORFL,U,1)_"^"_$$FMTE^XLFDT($P(PSORFL,U,1),1)
  1. S ^TMP($J,LIST,IEN,"RF",FILL,1)=$P(PSORFL,U,4)
  1. S ^TMP($J,LIST,IEN,"RF",FILL,1.1)=$P(PSORFL,U,10)
  1. S ^TMP($J,LIST,IEN,"RF",FILL,1.2)=$P(PSORFL,U,11)
  1. S ^TMP($J,LIST,IEN,"RF",0)=$G(^TMP($J,LIST,IEN,"RF",0))+1
  1. Q
  1. ;
  1. PART(IEN,FILL) ;PARTIAL FILL
  1. D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
  1. N PSOPART S PSOPART=$G(^PSRX(IEN,"P",FILL,0))
  1. S ^TMP($J,LIST,IEN,"P",FILL,.01)=$P(PSOPART,U,1)_"^"_$$FMTE^XLFDT($P(PSOPART,U,1),1)
  1. S ^TMP($J,LIST,IEN,"P",FILL,.04)=$P(PSOPART,U,4)
  1. S ^TMP($J,LIST,IEN,"P",FILL,.041)=$P(PSOPART,U,10)
  1. S ^TMP($J,LIST,IEN,"P",FILL,.042)=$P(PSOPART,U,11)
  1. S ^TMP($J,LIST,IEN,"P",0)=$G(^TMP($J,LIST,IEN,"P",0))+1
  1. Q
  1. ;
  1. ORIG(IEN) ;ORIGINAL FILL
  1. N PSOORIG S PSOORIG=$G(^PSRX(IEN,0))
  1. S ^TMP($J,LIST,IEN,.01)=$P(PSOORIG,U,1)
  1. S ^TMP($J,LIST,IEN,2)=$S($P(PSOORIG,U,2)>0:$P(PSOORIG,U,2)_"^"_$P($G(^DPT($P($G(PSOORIG),U,2),0)),U,1),1:"")
  1. S ^TMP($J,LIST,IEN,6)=$S($P(PSOORIG,U,6)>0:$P(PSOORIG,U,6)_"^"_$P($G(^PSDRUG($P($G(PSOORIG),U,6),0)),U,1),1:"")
  1. S ^TMP($J,LIST,IEN,7)=$P(PSOORIG,U,7)
  1. S ^TMP($J,LIST,IEN,8)=$P(PSOORIG,U,8)
  1. S ^TMP($J,LIST,IEN,17)=$P(PSOORIG,U,17)
  1. Q
  1. ;
  1. REF(SDATE,EDATE,LIST) ; "AD" XREF RETRIEVAL
  1. ;SDATE: START DATE OF "AD" XREF RETRIEVAL [REQUIRED]
  1. ;EDATE: END DATE OF "AD" XREF RETRIEVAL [OPTIONAL]
  1. ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
  1. ;
  1. Q:$G(LIST)=""
  1. K ^TMP($J,LIST)
  1. I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
  1. I '$G(EDATE) S EDATE=SDATE
  1. N PSORXN,PSOFILL
  1. S DATE=SDATE-.001,END=EDATE+1,PSORXN="",PSOFILL=""
  1. F S DATE=$O(^PSRX("AD",DATE)) Q:'DATE!(END'>DATE) D
  1. .F S PSORXN=$O(^PSRX("AD",DATE,PSORXN)) Q:'PSORXN D
  1. ..F S PSOFILL=$O(^PSRX("AD",DATE,PSORXN,PSOFILL)) Q:PSOFILL="" D
  1. ...S ^TMP($J,LIST,"AD",DATE,PSORXN,PSOFILL)=""
  1. Q
  1. ;
  1. ARXREF(PSODATE,PSOIEN,PSOFILL) ; SUSPENSE STATUS CHECK
  1. ;PSODATE: RELEASED DATE/TIME
  1. ;PSOIEN: INTERNAL ENTRY NUMBER
  1. ;PSOFILL: FILL NUMBER OF PRESCRIPTION
  1. ;
  1. I $G(PSODATE)=""!($G(PSOIEN)="")!($G(PSOFILL)="") Q 0
  1. N RESULT S RESULT=0
  1. I $D(^PSRX("AR",PSODATE,PSOIEN,PSOFILL)) S RESULT=1
  1. Q RESULT
  1. ;
  1. PARK(ORIEN) ; DETERMINES IF A PRESCRIPTION IS PARK
  1. ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
  1. ;
  1. I $G(ORIEN)="" Q 0
  1. N PSOIEN
  1. S PSOIEN=$O(^PSRX("APL",ORIEN,""))
  1. I +PSOIEN=0 Q 0
  1. I $G(^PSRX(PSOIEN,"STA"))'=0 Q 0
  1. N RESULT S RESULT=0
  1. I $G(^PSRX(PSOIEN,"PARK"))=1 S RESULT=1
  1. Q RESULT
  1. SUSP(ORIEN) ; DETERMINES IF A PRESCRIPTION IS SUSPENDED
  1. ;ORIEN: ORDER FILE (#100) INTERNAL ENTRY NUMBER
  1. ;
  1. I $G(ORIEN)="" Q 0
  1. N PSOIEN
  1. S PSOIEN=$O(^PSRX("APL",ORIEN,""))
  1. I +PSOIEN=0 Q 0
  1. I $G(^PSRX(PSOIEN,"STA"))=5 Q 1
  1. Q 0