source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPXRM1.m@ 1128

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1PSOPXRM1 ;BHAM ISC/MR - Returns Patient's Prescrition info ; 07/12/2004
2 ;;7.0;OUTPATIENT PHARMACY;**118**;DEC 1997
3 ;
4NVA(DAS,DATA) ;Return data on non-VA meds.
5 N EM,IND1,IND2,IND3,IND4,TEMP,TEMP1
6 S IND1=$P(DAS,";",1),IND2=$P(DAS,";",2),IND3=$P(DAS,";",3),IND4=$P(DAS,";",4)
7 ;W !,"IN NVA^PSOPXRM1" BREAK
8 S TEMP=^PS(55,IND1,IND2,IND3,IND4)
9 S TEMP1=^PS(50.7,$P(TEMP,U,1),0)
10 ;DBIA #2223
11 S DATA("ORDERABLE ITEM")=$P(TEMP1,U,1)
12 ;DBIA #2174
13 S DATA("DOSAGE FORM")=^PS(50.606,$P(TEMP1,U,2),0)
14 S DATA("DISPENSE DRUG")=$P(TEMP,U,2)
15 S DATA("DOSAGE")=$P(TEMP,U,3)
16 S DATA("MEDICATION ROUTE")=$P(TEMP,U,4)
17 S DATA("SCHEDULE")=$P(TEMP,U,5)
18 S TEMP1=$P(TEMP,U,6)
19 S DATA("STATUS")=$S(TEMP1="":"ACTIVE",1:$$EXTERNAL^DILFD(55.05,5,"",TEMP1,.EM))
20 S DATA("DISCONTINUED DATE")=$P(TEMP,U,7)
21 S DATA("ORDER NUMBER")=$P(TEMP,U,8)
22 S DATA("START DATE")=$P(TEMP,U,9)
23 S DATA("DOCUMENTED DATE")=$P(TEMP,U,10)
24 S DATA("DOCUMENTED BY")=$P(TEMP,U,11)
25 S DATA("CLINIC")=$P(TEMP,U,12)
26 ;W !,"NVA^PSOPXRM1 DONE" BREAK
27 Q
28 ;
29 ;====================================================
30PSRX(DAS,RXAR) ; Returns Rx Information
31 ; Input: DAS - String containing the ^PSRX location where the data
32 ; is located, separated by ";" (semi-colon).
33 ; Example: "329832;1;1;0" -> ^PSRX(329832,1,1,0)
34 ;Output: .RXAR - Array/Global to be returned with the Rx Info (by Ref)
35 ; Return: RXAR(Field Name)=Internal Value
36 ;
37 N SB1,SB2,SB3,I,DA
38 ;
39 ; - Retrieving ^PSRX subscripts
40 F I=1:1:3 S @("SB"_I)=$P(DAS,";",I)
41 ;
42 ; - Call appropriate sub-routine (Original, Refill or Partial)
43 S DA=SB1 K RXAR D @($S(SB3="":"ORIG",SB2'="P":"REFL",1:"PRTL"))
44 ;
45 ; - Retrieve common fields
46 S RXAR("STATUS")=+$G(^PSRX(DA,"STA"))
47 ;
48END Q
49 ;
50ORIG ; - Retrieve Original fields
51 N RX0,RX2 S RX0=$G(^PSRX(DA,0)),RX2=$G(^PSRX(DA,2))
52 S RXAR("DAYS SUPPLY")=$P(RX0,"^",8)
53 S RXAR("PHARMACIST")=$P(RX2,"^",3)
54 S RXAR("RELEASED DATE/TIME")=$P(RX2,"^",13)
55 Q
56 ;
57REFL ; - Retrieve Refill fields
58 N RF0 S RF0=$G(^PSRX(DA,1,SB3,0))
59 S RXAR("DAYS SUPPLY")=$P(RF0,"^",10)
60 S RXAR("PHARMACIST")=$P(RF0,"^",5)
61 S RXAR("RELEASED DATE/TIME")=$P(RF0,"^",18)
62 Q
63 ;
64PRTL ; - Retrieve Partial fields
65 N PT0 S PT0=$G(^PSRX(DA,"P",SB3,0))
66 S RXAR("DAYS SUPPLY")=$P(PT0,"^",10)
67 S RXAR("PHARMACIST")=$P(PT0,"^",5)
68 S RXAR("RELEASED DATE/TIME")=$P(PT0,"^",19)
69 Q
Note: See TracBrowser for help on using the repository browser.