PPPGET8 ;ALB/DMB - GET LOCAL PHARMACY DATA ; 3/11/92
 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
GLPHRM(PATDFN,ARRYNM) ; Get the local data
 ;
 N PPPTMP,DA,DIC,DIQ,DR,FOUND,PARMERR,RVRSDT,RXCUTOFF
 N RXDATA,RXIFN,SRCHDT,STANAME,STANO,X,X1,X2
 ;
 S PARMERR=-9001
 S RXCUTOFF=90
 S FOUND=0
 ;
 I '$D(PATDFN) Q PARMERR
 I '$D(ARRYNM) Q PARMERR
 I ARRYNM="" Q PARMERR
 ;
 ; Get the cutoff date
 ;
 S X1=DT,X2=-RXCUTOFF
 D C^%DTC
 S SRCHDT=X
 ;
 ; Get the local station name
 ;
 S STANO=+$P($G(^PPP(1020.1,1,0)),"^",9)
 I STANO>0 S STANAME=$P($$GETSNIFN^PPPGET1(STANO),"^",2)
 E  S STANO="UNKNOWN"
 I STANAME="" S STANAME="UNKNOWN"
 ;
 ; Get the narrative
 ;
 S DIC=55,DA=PATDFN,DR="1",DIQ="PPPTMP" D EN^DIQ1
 I $G(PPPTMP(55,PATDFN,1))'="" S @ARRYNM@(0,STANAME)=PPPTMP(55,PATDFN,1)
 K PPPTMP
 ;
 ; Order through the "A" xref to find the RX's
 ;
 F SRCHDT=SRCHDT:0 D  Q:'SRCHDT
 .S SRCHDT=$O(^PS(55,PATDFN,"P","A",SRCHDT)) Q:'SRCHDT
 .F RXIFN=0:0 D  Q:'RXIFN
 ..S RXIFN=$O(^PS(55,PATDFN,"P","A",SRCHDT,RXIFN)) Q:'RXIFN
 ..S RXDATA=$$GETPHDAT(RXIFN,SRCHDT,STANO,STANAME)
 ..I RXDATA<0 Q
 ..S RVRSDT=9999999-(+$P(RXDATA,"^",6))
 ..S @ARRYNM@(RVRSDT,STANO,RXIFN)=RXDATA
 ..S FOUND=FOUND+1
 Q FOUND
 ;
GETPHDAT(RXIFN,SRCHDT,STANO,STANAME) ; Get the data via fileman
 ;
 N PPPTMP,RXNODE0,STATUS,DIC,DA,DR,DIQ,LFDT,RXNUM,ISSUEDT,DRUG,QTY,SIG
 N RESULT,PARMERR,FMERR,U,PROVIDER
 ;
 S PARMERR=-9001
 S FMERR=-9002
 S U="^"
 ;
 S RXNODE0=$G(^PSRX(RXIFN,0))
 I RXNODE0="" Q PARMERR
 ;
 S STATUS=$S(SRCHDT'<DT:"A",$P(RXNODE0,"^",15)=12:"C",1:"E")
 ;
 S DIC=52
 S DA=RXIFN
 S DR=".01;1;4;6;7;10;101"
 S DIQ="PPPTMP"
 S DIQ(0)="IE"
 D EN^DIQ1
 I '$D(PPPTMP) Q FMERR
 ;
 S LFDT=PPPTMP(52,RXIFN,101,"I")
 S RXNUM=PPPTMP(52,RXIFN,.01,"E")
 S ISSUEDT=PPPTMP(52,RXIFN,1,"I")
 S PROVIDER=PPPTMP(52,RXIFN,4,"E")
 S DRUG=PPPTMP(52,RXIFN,6,"E")
 S QTY=PPPTMP(52,RXIFN,7,"E")
 S SIG=PPPTMP(52,RXIFN,10,"E")
 S RESULT=RXNUM_U_DRUG_U_STATUS_U_QTY_U_ISSUEDT_U_LFDT_U_SIG_U_STANAME_U_STANO_U_PROVIDER
 Q RESULT