source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPGET8.m@ 1245

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

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1PPPGET8 ;ALB/DMB - GET LOCAL PHARMACY DATA ; 3/11/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GLPHRM(PATDFN,ARRYNM) ; Get the local data
6 ;
7 N PPPTMP,DA,DIC,DIQ,DR,FOUND,PARMERR,RVRSDT,RXCUTOFF
8 N RXDATA,RXIFN,SRCHDT,STANAME,STANO,X,X1,X2
9 ;
10 S PARMERR=-9001
11 S RXCUTOFF=90
12 S FOUND=0
13 ;
14 I '$D(PATDFN) Q PARMERR
15 I '$D(ARRYNM) Q PARMERR
16 I ARRYNM="" Q PARMERR
17 ;
18 ; Get the cutoff date
19 ;
20 S X1=DT,X2=-RXCUTOFF
21 D C^%DTC
22 S SRCHDT=X
23 ;
24 ; Get the local station name
25 ;
26 S STANO=+$P($G(^PPP(1020.1,1,0)),"^",9)
27 I STANO>0 S STANAME=$P($$GETSNIFN^PPPGET1(STANO),"^",2)
28 E S STANO="UNKNOWN"
29 I STANAME="" S STANAME="UNKNOWN"
30 ;
31 ; Get the narrative
32 ;
33 S DIC=55,DA=PATDFN,DR="1",DIQ="PPPTMP" D EN^DIQ1
34 I $G(PPPTMP(55,PATDFN,1))'="" S @ARRYNM@(0,STANAME)=PPPTMP(55,PATDFN,1)
35 K PPPTMP
36 ;
37 ; Order through the "A" xref to find the RX's
38 ;
39 F SRCHDT=SRCHDT:0 D Q:'SRCHDT
40 .S SRCHDT=$O(^PS(55,PATDFN,"P","A",SRCHDT)) Q:'SRCHDT
41 .F RXIFN=0:0 D Q:'RXIFN
42 ..S RXIFN=$O(^PS(55,PATDFN,"P","A",SRCHDT,RXIFN)) Q:'RXIFN
43 ..S RXDATA=$$GETPHDAT(RXIFN,SRCHDT,STANO,STANAME)
44 ..I RXDATA<0 Q
45 ..S RVRSDT=9999999-(+$P(RXDATA,"^",6))
46 ..S @ARRYNM@(RVRSDT,STANO,RXIFN)=RXDATA
47 ..S FOUND=FOUND+1
48 Q FOUND
49 ;
50GETPHDAT(RXIFN,SRCHDT,STANO,STANAME) ; Get the data via fileman
51 ;
52 N PPPTMP,RXNODE0,STATUS,DIC,DA,DR,DIQ,LFDT,RXNUM,ISSUEDT,DRUG,QTY,SIG
53 N RESULT,PARMERR,FMERR,U,PROVIDER
54 ;
55 S PARMERR=-9001
56 S FMERR=-9002
57 S U="^"
58 ;
59 S RXNODE0=$G(^PSRX(RXIFN,0))
60 I RXNODE0="" Q PARMERR
61 ;
62 S STATUS=$S(SRCHDT'<DT:"A",$P(RXNODE0,"^",15)=12:"C",1:"E")
63 ;
64 S DIC=52
65 S DA=RXIFN
66 S DR=".01;1;4;6;7;10;101"
67 S DIQ="PPPTMP"
68 S DIQ(0)="IE"
69 D EN^DIQ1
70 I '$D(PPPTMP) Q FMERR
71 ;
72 S LFDT=PPPTMP(52,RXIFN,101,"I")
73 S RXNUM=PPPTMP(52,RXIFN,.01,"E")
74 S ISSUEDT=PPPTMP(52,RXIFN,1,"I")
75 S PROVIDER=PPPTMP(52,RXIFN,4,"E")
76 S DRUG=PPPTMP(52,RXIFN,6,"E")
77 S QTY=PPPTMP(52,RXIFN,7,"E")
78 S SIG=PPPTMP(52,RXIFN,10,"E")
79 S RESULT=RXNUM_U_DRUG_U_STATUS_U_QTY_U_ISSUEDT_U_LFDT_U_SIG_U_STANAME_U_STANO_U_PROVIDER
80 Q RESULT
Note: See TracBrowser for help on using the repository browser.