source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPDX1.m@ 1042

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1PPPPDX1 ;ALB/DMB - PPP PDX ROUTINES ; 2/21/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**2,8,21**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SNDPDX(PATDFN,SPARRY,ERRARRY) ; Send a PDX message for a patient
6 ;
7 N ARRYNM,DA,DIC,DIQ,DR,DUOUT,DTOUT,DOMAIN
8 N ERR,FFXIFN,I,PARMERR,PDXERR,RFNERR,STAPTR,TMP
9 N X,DOMARR,SEGARR,NOTARR,MSGPOS
10 ;
11 S ERR=0
12 S PDXERR=-9008
13 S PARMERR=-9001
14 S RFNERR=-9009
15 S FFXIFN=0
16 ;
17 I '$D(PATDFN) Q PARMERR
18 I '$D(@SPARRY) Q PARMERR
19 I PATDFN<1 Q PARMERR
20 I '$D(PDXSNT) S PDXSNT=0
21 ;
22 S X="VAQUIN01" X ^%ZOSF("TEST") I ('$T) Q RFNERR
23 ;
24 ; Order through the station pointer array and generate PDX Request
25 ;
26 F STAPTR=0:0 D Q:STAPTR=""
27 .S STAPTR=$O(@SPARRY@(STAPTR)) Q:STAPTR=""
28 .;
29 .; First get the domain name from the FFX file
30 .;
31 .S FFXIFN=$O(^PPP(1020.2,"APOV",PATDFN,STAPTR,""))
32 .I FFXIFN="" D Q
33 ..S TMP=$$POSTERR(ERRARRY,FFXIFN,"Could Not Find Entry In APOV xref for Patient DFN "_PATDFN)
34 .S DOMAIN=$P($G(^PPP(1020.2,FFXIFN,1)),"^",5)
35 .S LNUM=0 I DOMAIN]"" S LNUM=$O(^PPP(1020.128,"A",DOMAIN,0))
36 .I LNUM S DOMAIN=$P(^PPP(1020.128,LNUM,0),"^",2)
37PTCH .;DAVE B (PPP*1*21)
38 .S DATA=$G(^PPP(1020.2,FFXIFN,0))
39 .I DOMAIN="",$P(DATA,"^",2)'="" S DOMAIN=$$GETDOMNM^PPPGET3($P(DATA,"^",2))
40 .S XX=FFXIFN,DATA=$G(^PPP(1020.2,FFXIFN,0)),ERRTXT="No Domain Entry in FFX file for --> "
41 .I DOMAIN="" F IDX=1:1 S TMP=$O(@SPARRY@(IDX)) Q:TMP=""
42 .I DOMAIN="" S @ERRARRY@(IDX+1)=ERRTXT_$S($P(DATA,"^")="":FFXIFN,1:$$GETPATNM^PPPGET1($P(DATA,"^")))_" at "_$P(DATA,"^",2) Q
43 .K DOMARR
44 .S DOMARR(DOMAIN)=""
45 .;SET SEGMENT ARRAY (REQUEST MINIMAL AND MED PROFILE LONG)
46 .K SEGARR
47 .S SEGARR("PDX*MIN")=""
48 .S SEGARR("PDX*MPL")=""
49 .;SET NOTIFY ARRAY (DON'T NOTIFY ANYONE)
50 .K NOTARR
51 .S NOTARR=""
52 .;REQUEST PDX INFORMATION
53 .S X=$$PDX^VAQUIN01("REQ",PATDFN,"","","","DOMARR","SEGARR","NOTARR")
54 .;ERROR
55 .I (+X) D Q
56 ..S TMP=$$POSTERR(ERRARRY,FFXIFN,"Error sending PDX to "_DOMAIN)
57 ..S ERR=PDXERR
58 .S PDXSNT=PDXSNT+1
59 .S TMP=$$POSTMSG(ERRARRY,FFXIFN,PDXSNT)
60 .;
61 .; Update the last batch request date field
62 .;
63 .S DIE=1020.2,DA=FFXIFN,DR="6///TODAY" D ^DIE
64 ;UPDATE STATISTICS
65 I PDXSNT>0 D
66 .S TMP=$$STATUPDT^PPPMSC1(2,PDXSNT)
67 .S @ERRARRY@(10001)=""
68 .S @ERRARRY@(10002)=""
69 .S @ERRARRY@(10003)="The following PDX request were generated by PPP on "_$$SLASHDT^PPPCNV1(DT)
70 .S @ERRARRY@(10004)=""
71 .S @ERRARRY@(10005)="NAME SSN STATION"
72 .S @ERRARRY@(10006)="------------------------- ---------- -------------------------"
73 .S MSGPOS=10006+PDXSNT
74 .;S @ERRARRY@(MSGPOS+1)=""
75 .;S @ERRARRY@(MSGPOS+2)=""
76 .;S @ERRARRY@(MSGPOS+3)="Total Sent = "_PDXSNT
77 ;
78 Q ERR
79 ;
80POSTERR(ARRYNM,XRFIFN,ERRTXT) ; Add an error to the error list
81 ;
82 N IDX,LKUPERR,PARMERR,PATDFN,PATNAME,SNIFN,STANAME,STATCODE,STATIFN
83 N STATTXT,TMP
84 ;
85 S PARMERR=-9001
86 S LKUPERR=-9003
87 ;
88 ; Check Parameters
89 ;
90 I '$D(ARRYNM) Q PARMERR
91 I '$D(XRFIFN) Q PARMERR
92 I ARRYNM="" Q PARMERR
93 I '$D(ERRTXT) S ERRTXT=""
94 ;
95 ; Get the patient name and station name
96 ;
97 S PATNAME="UNKNOWN"
98 I FFXIFN'="" D
99 .S PATDFN=$P($G(^PPP(1020.2,XRFIFN,0)),"^")
100 .I PATDFN'="" S PATNAME=$$GETPATNM^PPPGET1(PATDFN)
101 ;
102 ; Set the array
103 ;
104 F IDX=1:1 S TMP=$O(@ARRYNM@(IDX)) Q:TMP=""
105 S @ARRYNM@(IDX+1)=ERRTXT_" --> Entry #: "_$S(PATNAME="UNKNOWN":$G(XRFIFN),1:PATNAME)_" at "_$S($G(DOMAIN)="":$P($G(^PPP(1020.2,XRFIFN,0)),"^",2),1:DOMAIN)
106 ;
107 Q 0
108 ;
109POSTMSG(ARRYNM,XRFIFN,MSGCNT) ; Add message line for PDX's sent
110 ;
111 N IDX,LKUPERR,PARMERR,PATDFN,PATNAME,SNIFN,STANAME
112 N TMP,PATSSN,SP25
113 ;
114 S PARMERR=-9001
115 S LKUPERR=-9003
116 S SP25=" "
117 ;
118 ; Check Parameters
119 ;
120 I '$D(ARRYNM) Q PARMERR
121 I '$D(XRFIFN) Q PARMERR
122 I ARRYNM="" Q PARMERR
123 I '$D(MSGCNT) Q PARMERR
124 ;
125 ; Get the patient name and station name and SSN
126 ;
127 S PATNAME="UNKNOWN"
128 I FFXIFN'="" D
129 .S PATDFN=$P($G(^PPP(1020.2,XRFIFN,0)),"^")
130 .I PATDFN'="" S PATNAME=$$GETPATNM^PPPGET1(PATDFN),PATSSN=$$GETSSN^PPPGET1(PATDFN)
131 ; Set the array, beginning at 10,006
132 ;
133 S IDX=10006+MSGCNT
134 S @ARRYNM@(IDX)=$E(PATNAME_SP25,1,25)_" "_$E(PATSSN_SP25,1,10)_" "_DOMAIN
135 ;
136 Q 0
137EDITSITE ;
138 W ! S DIC("A")="Select LEGACY SITE: ",DIC="^PPP(1020.128,",DIC(0)="QEALMZ",DLAYGO="1020.128"
139 D ^DIC I $D(DTOUT)!$D(DUOUT)!(Y<1) G END
140 S DIE="^PPP(1020.128,",(DA,PPPDA)=+Y,DR=".01;.02;1" D ^DIE
141 I $P($G(^PPP(1020.128,PPPDA,0)),"^",2)="" W !!,"Missing Merged Site for ",$P($G(^DIC(4.2,PPPDA,0)),"^"),!,"Now Deleting Entry." S DIK="^PPP(1020.128,",DA=PPPDA D ^DIK
142 G EDITSITE
143END ;
144 K DIC,DIE,DA,Y,DR,DIK,PPPDA
145 Q
Note: See TracBrowser for help on using the repository browser.