| 1 | PPPGET8 ;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 | ;
|
|---|
| 5 | GLPHRM(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 | ;
|
|---|
| 50 | GETPHDAT(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
|
|---|
