source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHDR.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1PSOHDR ;BIR/RTR-Send order update message to HDR ;06/27/03
2 ;;7.0;OUTPATIENT PHARMACY;**181,205**;DEC 1997
3 ;External reference to PSDRUG supported by DBIA 221
4 ;External reference to VDEFQM supported by DBIA 4253
5 ;
6 ;PSOHDRTP = Type of message, PRES=fill, PPAR=partial, PREF=refill
7 ;PSOHDRNM = Internal entry number of order
8 ;
9EN(PSOHDRTP,PSOHDRNM) ; Entry point for VDEF calls
10 Q:'$G(PSOHDRNM)
11 Q:$G(PSOHDRTP)=""
12 I $T(QUEUE^VDEFQM)']"" Q
13 I '$D(^PSRX(PSOHDRNM,0)) Q
14 ;Check for test patient
15 I $T(TESTPAT^VADPT)]"" Q:$$TESTPAT^VADPT(+$P($G(^PSRX(PSOHDRNM,0)),"^",2))
16 N PSOHDRX,PSOHDRA,PSOHDRB
17 S PSOHDRA=$S(PSOHDRTP="PRES":"RDE^O11",PSOHDRTP="PPAR":"RDS^O13",PSOHDRTP="PREF":"RDS^O13",1:"")
18 Q:PSOHDRA=""
19 S PSOHDRB="SUBTYPE="_PSOHDRTP_"^IEN="_PSOHDRNM
20 S PSOHDRX=$$QUEUE^VDEFQM(PSOHDRA,PSOHDRB)
21 Q
22 ;
23 ;Return NDC number
24NDC(PSOVIEN,PSOVFILL,PSOVTYPE) ;
25 ;PSOVIEN = Internal prescription number
26 ;PSOVFILL = Fill Number
27 ;PSOVTYPE = "R" for refill, "P" for Partial
28 N PSOVNDC,PSOVNX,PSOVY,PSOVDRG
29 S (PSOVNDC,PSOVNX)=""
30 I $G(PSOVIEN)'>0 Q PSOVNDC
31 I '$D(^PSRX(PSOVIEN,0)) Q PSOVNDC
32 I $G(PSOVFILL)="" Q PSOVNDC
33 I PSOVFILL=0 D D:PSOVNX'="" FORMAT Q PSOVNDC
34 .D CMOP I PSOVNX'="" Q
35 .;I $P($G(^PSRX(PSOVIEN,"NDC")),"^")'="" S PSOVNX=$P(^("NDC"),"^") Q
36 .I $P($G(^PSRX(PSOVIEN,2)),"^",7)'="" S PSOVNX=$P(^(2),"^",7) Q
37 .D DRUG
38 I $G(PSOVFILL)'>0 Q PSOVNDC
39 I $G(PSOVTYPE)'="R",$G(PSOVTYPE)'="P" Q PSOVNDC
40 I PSOVTYPE="R" D D:PSOVNX'="" FORMAT Q PSOVNDC
41 .D CMOP I PSOVNX'="" Q
42 .;I $P($G(^PSRX(PSOVIEN,1,PSOVFILL,"NDC")),"^")'="" S PSOVNX=$P(^("NDC"),"^") Q
43 .I $P($G(^PSRX(PSOVIEN,1,PSOVFILL,1)),"^",3)'="" S PSOVNX=$P(^(1),"^",3) Q
44 .D DRUG
45 I PSOVTYPE="P" D D:PSOVNX'="" FORMAT Q PSOVNDC
46 .I $P($G(^PSRX(PSOVIEN,"P",PSOVFILL,0)),"^",12)'="" S PSOVNX=$P(^(0),"^",12) Q
47 .D DRUG
48 Q PSOVNDC
49 ;
50FORMAT ;format NDC
51 S PSOVNDC=$G(PSOVNX)
52 Q
53CMOP ;Find NDC for CMOP fill
54 F PSOVY=0:0 S PSOVY=$O(^PSRX(PSOVIEN,4,PSOVY)) Q:'PSOVY D
55 .I $P($G(^PSRX(PSOVIEN,4,PSOVY,0)),"^",3)=PSOVFILL,$P($G(^(0)),"^",8)'="" S PSOVNX=$P($G(^(0)),"^",8)
56 Q
57DRUG ;Get NDC from Drug file
58 S PSOVDRG=$P($G(^PSRX(PSOVIEN,0)),"^",6) I PSOVDRG,$P($G(^PSDRUG(+$G(PSOVDRG),2)),"^",4)'="" S PSOVNX=$P(^(2),"^",4)
59 Q
Note: See TracBrowser for help on using the repository browser.