source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPBLD1.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1PPPBLD1 ;ALB/DMB - BUILD FFX FROM CDROM : 3/4/92
2 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**38,39**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;Reference to ^DIC(4) are covered by IA# 10090
6 ;
7BFFX(INARRY,OUTARRY,EXCARRY,LSTPROC) ; Build the Foreign Facility Xref
8 ;
9 N PPPTMP,BFFSEND,BFFSTRT,DA,DIC,DIE,DR,ERR,ERRARY1,ERRARY2,ERRORS
10 N ERRTXT,FFXIFN,FFXLDOV,I,LOCKERR,MAXTM,MPDERR,MPDLDOV,PATDFN
11 N RTRNSITE,SNIFN,SSN,STANO,STARTTM,STATUS,TEDTENT
12 N TMP,TNEWENT,X,Y,MPDSTERR
13 N BUFFER,GROUND
14 ;
15 S LOCKERR=-9004
16 S MPDERR=-9014
17 S MPDERR2=-9015
18 S MPDSTERR=-9018
19 S BFFSTRT=1012
20 S BFFSEND=1013
21 S RTRNSITE=1
22 S BUFFER=5
23 S GROUND=0
24 S ERRARY1="^"_"TMP(""PPP"",$J,""ERR"","
25 S ERRARY2="^"_"TMP(""PPP"",$J,""ERR"")"
26 S @ERRARY2@(1)="The following errors occurred while running BFFX^PPPBLD1."
27 S @ERRARY2@(2)=" "
28 S MAXTM=7200
29 I '$D(PPPMRT) S PPPMRT="BFFX_PPPBLD1"
30 S (ERR,ERRORS,STATUS,TNEWENT,TEDTENT,TSSN)=0
31 ;
32LOCKFFX ; Attempt to lock the FFX file. Exit if you can't
33 ;
34 L +(^PPP(1020.2)):60
35 I '$T D Q LOCKERR
36 .S TMP=$$LOGEVNT^PPPMSC1(LOCKERR,PPPMRT)
37 .S PPPTMP(1)="BFFX^PPPBLD1 -> FFX locked by another user."
38 .S TMP=$$SNDBLTN^PPPMSC1("PPP NOTIFICATION","PRESCRIPTION PRACTICES","PPPTMP(")
39 .K PPPTMP
40 ;
41 D FIND
42STRTMPD ;VMP OIFO BAY PINES;ELR;PPP*1*38
43 ;REMOVED START MPD PROCESS
44 ;
45 ;
46 D GETDATA^PPPBLD1A
47 ;
48 K @OUTARRY,@ERRARY2,@EXCARRY
49 Q ERR_"^"_TNEWENT_"^"_TEDTENT
50 ;
51FIND ;VMP OIFO BAY PINES;ELR;PPP*1*38
52 ; GET PATIENT/VISIT DATA
53 NEW DATA,PPPDA,PPPDATA,PPPDFN,PPPSITE,PPPSSN,PPPVST,PPPX1
54 S PPPSSN=0
55 F S PPPSSN=$O(@INARRY@(PPPSSN)) Q:PPPSSN="" D
56 .S PPPDFN=+$$GETDFN^PPPGET1(PPPSSN)
57 .I $G(PPPDFN)'>0 S @OUTARRY@("DONE",PPPSSN)="",@OUTARRY@(PPPSSN,"FOUND")="-1^Could not find SSN "_PPPSSN_" in Patient File." Q
58 .K PPPDATA D TFL^VAFCTFU1(.PPPDATA,PPPDFN) ;Supported IA #2990
59 .S PPPX1=0
60 .F S PPPX1=$O(PPPDATA(PPPX1)) Q:PPPX1'>0 S DATA=PPPDATA(PPPX1) D
61 ..Q:$P(DATA,"^",5)'="VAMC"
62 ..S PPPSITE=$P(DATA,"^",1)
63 ..Q:PPPSITE=$P($G(^PPP(1020.1,1,0)),"^",9)
64 ..S PPPVST=$P($P(DATA,"^",3),".")
65 ..;VMP OIFO BAY PINES;VGF;PPP*1.0*39
66 ..N PPPIIEN
67 ..S PPPIIEN=$O(^DIC(4,"D",PPPSITE,0))
68 ..S @OUTARRY@(PPPSSN,"SITES",PPPIIEN)=PPPVST
69 .S @OUTARRY@("DONE",PPPSSN)=""
70 .S @OUTARRY@(PPPSSN,"FOUND")="1"
71 S @OUTARRY@("STATUS")="1^" ;1 MEANS NO ERRORS (AS THERE IS NO LONGER A CD ROM SERVER) SO NO MSG SENT IN PIECE 2
72 Q
Note: See TracBrowser for help on using the repository browser.