| 1 | PPPGET2 ;ALB/DMB - PDX DATA EXTRACT ROUTINES ; 3/2/92
|
|---|
| 2 | ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**10**;APR 7,1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | GETPDX(PDXPARRY,ARRYNM) ; Get the pdx pharmacy data and put it in arraynm
|
|---|
| 6 | ;
|
|---|
| 7 | ; This function extracts the needed pharmacy data from the
|
|---|
| 8 | ; PDX data file and stores it in ARRYNM. It stores it sorted
|
|---|
| 9 | ; by last fill date with the most recent date first.
|
|---|
| 10 | ;
|
|---|
| 11 | ; Parameters:
|
|---|
| 12 | ; PDXPARRY - Array containing the PDX Data File IFN's
|
|---|
| 13 | ; ARRYNM - Name of array to store results in
|
|---|
| 14 | ;
|
|---|
| 15 | N DRUG,ERR,ISSUEDT,LFDT,PARMERR,QTY,RX,RXNUM,SIG,STANO,STATUS
|
|---|
| 16 | N XTARRY,RFNERR,XTRCTERR,STANAME,PROVIDER,TRANPTR,SEGPTR,X
|
|---|
| 17 | ;
|
|---|
| 18 | S PARMERR=-9001
|
|---|
| 19 | S RFNERR=-9009
|
|---|
| 20 | S XTRCTERR=-9010
|
|---|
| 21 | S ERR=0
|
|---|
| 22 | ;
|
|---|
| 23 | S XTARRY="^UTILITY(""VAQ"","_$J_")"
|
|---|
| 24 | ;
|
|---|
| 25 | I '$D(@PDXPARRY) Q PARMERR
|
|---|
| 26 | ;
|
|---|
| 27 | S X="VAQUPD25" X ^%ZOSF("TEST") I ('$T) Q RFNERR
|
|---|
| 28 | ;
|
|---|
| 29 | ;GET POINTER TO SEGMENT 'PDX*MPL' (MED PROFILE LONG)
|
|---|
| 30 | S SEGPTR=+$O(^VAT(394.71,"C","PDX*MPL",""))
|
|---|
| 31 | Q:('SEGPTR) XTRCTERR
|
|---|
| 32 | ;
|
|---|
| 33 | S STANAME=""
|
|---|
| 34 | F S STANAME=$O(@PDXPARRY@(STANAME)) Q:(STANAME="") D
|
|---|
| 35 | .S TRANPTR=$P(@PDXPARRY@(STANAME,0),"^",2) Q:(TRANPTR<1)
|
|---|
| 36 | .S STANO=$P($G(@PDXPARRY@(STANAME,0)),"^",3)
|
|---|
| 37 | .;EXTRACT INFO
|
|---|
| 38 | .K @XTARRY
|
|---|
| 39 | .S X=$$EXTARR^VAQUPD25(TRANPTR,SEGPTR,XTARRY,0)
|
|---|
| 40 | .I (+X) D Q
|
|---|
| 41 | ..S TRANPTR=""
|
|---|
| 42 | ..S ERR=XTRCTERR
|
|---|
| 43 | .;GET NARRATIVE
|
|---|
| 44 | .S X=$G(@XTARRY@("VALUE",55,1,0)) S:(X'="") @ARRYNM@(0,STANAME)=X
|
|---|
| 45 | .;GET RX INFO
|
|---|
| 46 | .S RX=""
|
|---|
| 47 | .F S RX=$O(@XTARRY@("ID",52,.01,RX)) Q:(RX="") D
|
|---|
| 48 | ..S X=$G(@XTARRY@("VALUE",52,101,RX))
|
|---|
| 49 | ..S LFDT=$$E2IDT^PPPCNV1(X)
|
|---|
| 50 | ..S:(LFDT=-1) LFDT=""
|
|---|
| 51 | ..S X=$G(@XTARRY@("VALUE",52,1,RX))
|
|---|
| 52 | ..S ISSUEDT=$$E2IDT^PPPCNV1(X)
|
|---|
| 53 | ..S:(ISSUEDT=-1) ISSUEDT=""
|
|---|
| 54 | ..S RXNUM=$G(@XTARRY@("VALUE",52,.01,RX))
|
|---|
| 55 | ..S PROVIDER=$G(@XTARRY@("VALUE",52,4,RX))
|
|---|
| 56 | ..S PID=$G(@XTARRY@("VALUE",52,2,RX)) ;Dave B 14nov97
|
|---|
| 57 | ..S DRUG=$G(@XTARRY@("VALUE",52,6,RX))
|
|---|
| 58 | ..S QTY=$G(@XTARRY@("VALUE",52,7,RX))
|
|---|
| 59 | ..S SIG=$G(@XTARRY@("VALUE",52,10,RX)) S:$L(SIG)>100 SIG=$E(SIG,1,100)
|
|---|
| 60 | ..S STATUS=$G(@XTARRY@("VALUE",52,100,RX))
|
|---|
| 61 | ..S @ARRYNM@((9999999-LFDT),STANO,RX)=RXNUM_"^"_DRUG_"^"_STATUS_"^"_QTY_"^"_ISSUEDT_"^"_LFDT_"^"_SIG_"^"_STANAME_"^"_STANO_"^"_PROVIDER_"^"_PID
|
|---|
| 62 | ..;Next line added on 27Feb97 (Daveb)
|
|---|
| 63 | ..S @ARRYNM@((9999999-LFDT),STANO,"PID")=$G(^VAT(394.61,TRANPTR,"QRY")) ;Patient Name^SSN^DOB^SSN
|
|---|
| 64 | .K @XTARRY
|
|---|
| 65 | K @XTARRY
|
|---|
| 66 | Q ERR
|
|---|
