source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO52EX.m@ 1487

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PSO52EX ;BHAM ISC/AGV - API FOR ORIGINAL, REFILL, AND PARTIAL DATA ;07/13/06 10:30 am
2 ;;7.0;OUTPATIENT PHARMACY;**252,267**;DEC 1997;Build 3
3 ;
4 ;REFERENCE TO ^DPT SUPPORTED BY DBIA 10035
5 ;REFERENCE TO ^PSDRUG SUPPORTED BY DBIA 221
6 ;
7EXTRACT(SDATE,EDATE,LIST) ;MAIN DRIVER
8 ;SDATE: START DATE OF RECORD RETRIEVAL [REQUIRED]
9 ;EDATE: END DATE OF RECORD RETRIEVAL [OPTIONAL]
10 ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
11 ;
12 Q:$G(LIST)=""
13 K ^TMP($J,LIST)
14 I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
15 I '$G(EDATE) S EDATE=DT
16 D SEND
17 Q
18 ;
19SEND ;SENDS CONTROL TO $$CROSS. RECEIVES AND TRACKS COUNTS.
20 N ALCOUNT S ALCOUNT=$$CROSS("AL")
21 N AMCOUNT S AMCOUNT=$$CROSS("AM")
22 N TCOUNT S TCOUNT=ALCOUNT+AMCOUNT
23 IF TCOUNT>0 S ^TMP($J,LIST,0)=TCOUNT
24 ELSE S ^TMP($J,LIST,0)="-1^NO DATA FOUND"
25 Q
26 ;
27CROSS(REF) ;SETS UP ^TMP GLOBAL. SENDS FOR ORIGINAL, REFILL AND/OR PARTIAL FILL DATA
28 N PSOIEN,PSOFILL,PSOCOUNT,DATE,END
29 S DATE=SDATE-.001,END=(EDATE+1),PSOIEN="",PSOFILL="",PSOCOUNT=0
30 F S DATE=$O(^PSRX(REF,DATE)) Q:'DATE!(END'>DATE) D
31 .F S PSOIEN=$O(^PSRX(REF,DATE,PSOIEN)) Q:'PSOIEN D
32 ..F S PSOFILL=$O(^PSRX(REF,DATE,PSOIEN,PSOFILL)) Q:PSOFILL="" D
33 ...S ^TMP($J,LIST,REF,DATE,PSOIEN,PSOFILL)=""
34 ...I REF="AL",PSOFILL=0 S PSOCOUNT=PSOCOUNT+1 D ORIG(PSOIEN) Q
35 ...I REF="AL",PSOFILL>0 S PSOCOUNT=PSOCOUNT+1 D REFILL(PSOIEN,PSOFILL) Q
36 ...I REF="AM" S PSOCOUNT=PSOCOUNT+1 D PART(PSOIEN,PSOFILL) Q
37 Q PSOCOUNT
38 ;
39REFILL(IEN,FILL) ;REFILL
40 D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
41 N PSORFL S PSORFL=$G(^PSRX(IEN,1,FILL,0))
42 S ^TMP($J,LIST,IEN,"RF",FILL,.01)=$P(PSORFL,U,1)_"^"_$$FMTE^XLFDT($P(PSORFL,U,1),1)
43 S ^TMP($J,LIST,IEN,"RF",FILL,1)=$P(PSORFL,U,4)
44 S ^TMP($J,LIST,IEN,"RF",FILL,1.1)=$P(PSORFL,U,10)
45 S ^TMP($J,LIST,IEN,"RF",FILL,1.2)=$P(PSORFL,U,11)
46 S ^TMP($J,LIST,IEN,"RF",0)=$G(^TMP($J,LIST,IEN,"RF",0))+1
47 Q
48 ;
49PART(IEN,FILL) ;PARTIAL FILL
50 D:'$D(^TMP($J,LIST,IEN,.01)) ORIG(IEN)
51 N PSOPART S PSOPART=$G(^PSRX(IEN,"P",FILL,0))
52 S ^TMP($J,LIST,IEN,"P",FILL,.01)=$P(PSOPART,U,1)_"^"_$$FMTE^XLFDT($P(PSOPART,U,1),1)
53 S ^TMP($J,LIST,IEN,"P",FILL,.04)=$P(PSOPART,U,4)
54 S ^TMP($J,LIST,IEN,"P",FILL,.041)=$P(PSOPART,U,10)
55 S ^TMP($J,LIST,IEN,"P",FILL,.042)=$P(PSOPART,U,11)
56 S ^TMP($J,LIST,IEN,"P",0)=$G(^TMP($J,LIST,IEN,"P",0))+1
57 Q
58 ;
59ORIG(IEN) ;ORIGINAL FILL
60 N PSOORIG S PSOORIG=$G(^PSRX(IEN,0))
61 S ^TMP($J,LIST,IEN,.01)=$P(PSOORIG,U,1)
62 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:"")
63 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:"")
64 S ^TMP($J,LIST,IEN,7)=$P(PSOORIG,U,7)
65 S ^TMP($J,LIST,IEN,8)=$P(PSOORIG,U,8)
66 S ^TMP($J,LIST,IEN,17)=$P(PSOORIG,U,17)
67 Q
68 ;
69REF(SDATE,EDATE,LIST) ; "AD" XREF RETRIEVAL
70 ;SDATE: START DATE OF "AD" XREF RETRIEVAL [REQUIRED]
71 ;EDATE: END DATE OF "AD" XREF RETRIEVAL [OPTIONAL]
72 ;LIST: SUBSCRIPT NAME USED IN ^TMP GLOBAL [REQUIRED]
73 ;
74 Q:$G(LIST)=""
75 K ^TMP($J,LIST)
76 I '$G(SDATE) S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
77 I '$G(EDATE) S EDATE=SDATE
78 N PSORXN,PSOFILL
79 S DATE=SDATE-.001,END=EDATE+1,PSORXN="",PSOFILL=""
80 F S DATE=$O(^PSRX("AD",DATE)) Q:'DATE!(END'>DATE) D
81 .F S PSORXN=$O(^PSRX("AD",DATE,PSORXN)) Q:'PSORXN D
82 ..F S PSOFILL=$O(^PSRX("AD",DATE,PSORXN,PSOFILL)) Q:PSOFILL="" D
83 ...S ^TMP($J,LIST,"AD",DATE,PSORXN,PSOFILL)=""
84 Q
85 ;
86ARXREF(PSODATE,PSOIEN,PSOFILL) ; SUSPENSE STATUS CHECK
87 ;PSODATE: RELEASED DATE/TIME
88 ;PSOIEN: INTERNAL ENTRY NUMBER
89 ;PSOFILL: FILL NUMBER OF PRESCRIPTION
90 ;
91 I $G(PSODATE)=""!($G(PSOIEN)="")!($G(PSOFILL)="") Q 0
92 N RESULT S RESULT=0
93 I $D(^PSRX("AR",PSODATE,PSOIEN,PSOFILL)) S RESULT=1
94 Q RESULT
Note: See TracBrowser for help on using the repository browser.