source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOPRA.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: 4.0 KB
Line 
1PSOPRA ;BIR/JLC/MHA - INTERNET PRESCRIPTION REFILL APIS ; 4/14/05 4:51pm
2 ;;7.0;OUTPATIENT PHARMACY;**116,151,204,264**;DEC 1997;Build 19
3 ;
4 Q
5AP1(PSODFN,PSORX) ;ACCEPT REQUEST
6 ; Input: PSODFN (required) - Patient IEN Number
7 ; PSORX (required) - Prescription Number
8 ; Output: PSORET - Return Value
9 ; See IA# 3768 for description and values
10 ;
11 N PSORET,PSRX,PSRXD,IEN,PSORR,PSOICN,SITE,PSOSITE
12 I $G(PSODFN)="" S PSORET=-4 G QUITAP1
13 S PSOICN=+$$GETICN^MPIF001(PSODFN)
14 I +$G(PSOICN)=-1 S PSORET=-4 G QUITAP1
15 I $G(PSORX)="" S PSORET=-3 G QUITAP1
16 I $O(^PSRX("B",PSORX,""))="" S PSORET=-3 G QUITAP1
17 I '$D(^PSRX("B",PSORX)) S PSORET=-3 G QUITAP1
18 S PSRX=$O(^PSRX("B",PSORX,"")),PSRXD=$G(^PSRX(PSRX,0))
19 I PSRXD="" S PSORET=-3 G QUITAP1
20 I $P(PSRXD,"^",2)'=PSODFN S PSORET=-5 G QUITAP1
21 S (SITE,DA)=$P(^XMB(1,1,"XUS"),"^",17),DIC="4",DIQ(0)="IE",DR=".01;99",DIQ="PSXUTIL" D EN^DIQ1 S PSOSITE=$G(PSXUTIL(4,SITE,99,"I"))
22 I '$D(^PS(52.43,"AC",PSODFN,PSORX)) G FILEAP1
23 S IEN=$O(^PS(52.43,"AC",PSODFN,PSORX,""))
24 I '$D(^PS(52.43,IEN,0)) G FILEAP1
25 S PSORR=$G(^PS(52.43,IEN,0))
26 I $P(PSORR,"^",5)="" S PSORET=-2 G QUITAP1
27 S PSORET=-1 G QUITAP1
28FILEAP1 K DO,DIC,DD S DIC(0)="L",DIC=52.43,X=PSOICN D FILE^DICN I Y=-1 S PSORET=0 G QUITAP1
29 N % D NOW^%DTC
30 K DA,DR,DIE S DA=+Y,DIE=DIC,DR="3///"_PSORX_";7///0;8///"_PSRX_";4///"_PSOSITE_";9////"_PSODFN_";11///"_$E(%,1,12) D ^DIE
31 S PSORET=1
32QUITAP1 Q PSORET
33 ;
34AP2(PSODFN,PSORX) ;STATUS OF REQUEST
35 ; Input: PSODFN (required) - Patient IEN Number
36 ; PSORX (required) - Prescription Number
37 ; Output: PSORET - Return Value
38 ; See IA ... for description and values
39 ;
40 N PSORET,PSORR,IEN
41 I $G(PSODFN)="" S PSORET=-4 G QUITAP2
42 I $G(PSORX)="" S PSORET=-3 G QUITAP2
43 I '$D(^PS(52.43,"AC",PSODFN,PSORX)) S PSORET=-6 G QUITAP2
44 S IEN=$O(^PS(52.43,"AC",PSODFN,PSORX,""))
45 I '$D(^PS(52.43,IEN,0)) K ^PS(52.43,"AC",PSODFN,PSORX) S PSORET=-6 G QUITAP2
46 S PSORR=$G(^PS(52.43,IEN,0))
47 I $P(PSORR,"^",5)="" S PSORET=-2 G QUITAP2
48 S PSORET=$P(PSORR,"^",6)_"^"_$P(PSORR,"^",5)
49QUITAP2 Q PSORET
50 ;
51AP5(PSODFN,PSORX) ;PROCESS MHEV UPDATE
52 ; Input: PSODFN (required) - Patient IEN Number
53 ; PSORX (required) - Prescription Number
54 ; Output: PSORET - Return Value
55 ; See IA ... for description and values
56 ;
57 N PSORET,PSORR,IEN,PSOIN
58 I $G(PSODFN)="" S PSORET=-4 G ENDAP5
59 I $G(PSORX)="" S PSORET=-3 G ENDAP5
60 I '$D(^PS(52.43,"AC",PSODFN,PSORX)) S PSORET=-6 G ENDAP5
61 S IEN=$O(^PS(52.43,"AC",PSODFN,PSORX,""))
62 I '$D(^PS(52.43,IEN,0)) K ^PS(52.43,"AC",PSODFN,PSORX) S PSORET=-6 G ENDAP5
63 S PSORR=$G(^PS(52.43,IEN,0))
64 I $P(PSORR,"^",5)="" S PSORET=-2 G ENDAP5
65 S PSOIN=$P(PSORR,"^",4)
66 K DA,DR,DIE
67 S DA=IEN
68 S DIE="^PS(52.43,",DR="7///1" D ^DIE S PSORET=1
69 K ^PS(52.43,"AC",PSODFN,PSORX)
70ENDAP5 Q PSORET
71 ;
72AP6(PSODIEN,PSOAP6) ;OUTPATIENT PHARMACY DIVISION LOOKUP
73 ; Input: PSODIEN (required) - Outpatient Pharmacy Division IEN.
74 ; 1. Single Division IEN.
75 ; 2. Delimited list of Division IEN's (IEN1,IEN2,IEN3).
76 ; 3. Text word "ALL".
77 ; PSOAP6 (required) - Information return Array.
78 ; Output: PSOAP6 - Information return Array.
79 ; PSOAP6(DIV)=Active(0)/Inactive(1)
80 ; PSOAP6(DIV,1)=Division Name^Area Code^Phone Number
81 ; PSOAP6(DIV,2,1)=Narrative text 1st line.
82 ; PSOAP6(DIV,2,n)=Narrative text nth line.
83 ; PSORET - 0 (Process failure).
84 ; 1 (Process success).
85 ;
86 N DIEN,TEMP,NAME,AREACODE,PHONENUM,INACTIVE
87 Q:$G(PSODIEN)="" 0
88 I PSODIEN="ALL" S ZS2=$O(^PS(59,0)),PSODIEN=ZS2 Q:'+ZS2 0 F S ZS2=$O(^PS(59,ZS2)) Q:'+ZS2 S PSODIEN=PSODIEN_","_ZS2
89 F XX=1:1:$L(PSODIEN,",") S DIEN=$P(PSODIEN,",",XX) D
90 .S NAME=$$GET1^DIQ(59,DIEN,".01")
91 .Q:NAME=""
92 .S AREACODE=$$GET1^DIQ(59,DIEN,".03")
93 .S PHONENUM=$$GET1^DIQ(59,DIEN,".04")
94 .S INACTIVE=$$GET1^DIQ(59,DIEN,2004,"I")
95 .S PSOAP6(DIEN)=0 I INACTIVE S PSOAP6(DIEN)=1
96 .S PSOAP6(DIEN,1)=NAME_"^"_AREACODE_"^"_PHONENUM
97 .S TEMP=$$GET1^DIQ(59,DIEN,1005,"","PSOAP6("_DIEN_",2)")
98 ;
99ENDAP6 Q 1
Note: See TracBrowser for help on using the repository browser.