source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPBLD1A.m

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1PPPBLD1A ;ALB/DMB - BUILD FFX FROM CDROM - CONTINUED : 3/4/92
2 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**2,26,38,41**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GETDATA ;
6 ;
7 S STARTTM=$$NOW^PPPCNV1
8 ;VMP OIFO BAY PINES;PPP*1*41 CHANGED F I= TO F PPPI=
9 NEW PPPI
10 F PPPI=0:0 D Q:(STATUS)
11 .;
12 .;
13 .;
14CHKTM .;VMP OIFO BAY PINES;ELR;PPP*1*38
15 .;REMOVE CHECKING FOR TIMEOUT ON MPD
16GETSSN .S SSN=$O(@OUTARRY@("DONE",""))
17 .I SSN'="" D
18 ..S STARTTM=$$NOW^PPPCNV1
19 ..S TSSN=TSSN+1
20 ..S FOUND=$G(@OUTARRY@(SSN,"FOUND"))
21 ..I FOUND<1 D Q
22 ...I FOUND<0 D
23 ....S TMP=$$LOGEVNT^PPPMSC1(MPDERR2,PPPMRT,SSN_"/"_+FOUND)
24 ...K @OUTARRY@(SSN)
25 ...K @OUTARRY@("DONE",SSN)
26 ...D DEL
27 ..;
28GETDFN ..; Get the DFN for the SSN. If we can't then we have an invalid SSN.
29 ..;
30 ..S PATDFN=+$$GETDFN^PPPGET1(SSN)
31 ..I PATDFN<1 D Q
32 ...S STARTTM=$$NOW^PPPCNV1
33 ...S ERRTXT="Could not find SSN "_SSN_" in Patient File."
34 ...S ERRORS=1
35 ...S TMP=$$ADD2ERR^PPPBLD2(ERRARY2,ERRTXT)
36 ...K @OUTARRY@("DONE",SSN)
37 ...K @OUTARRY@(SSN)
38 ...D DEL
39 ..;
40GETSTA ..; Now get the station number. If its not in the institution file
41 ..; then reject it.
42 ..;
43 ..S STANO=0
44 ..F D Q:STANO=""
45 ...S STANO=$O(@OUTARRY@(SSN,"SITES",STANO)) Q:STANO=""
46 ...;
47 ...; We need the station IFN to look up the entry in the FFX file.
48 ...;
49 ...;S SNIFN=$O(^DIC(4,"D",STANO,""))
50 ...S SNIFN=STANO
51 ...I SNIFN="" D Q
52 ....S SNIFN=$O(^PPP(1020.128,"AC",STANO,0)) I SNIFN]"" Q
53 ....S STARTTM=$$NOW^PPPCNV1
54 ....S ERRTXT="Could not find station "_STANO_" in Institution File for SSN "_SSN_"."
55 ....S ERRORS=1
56 ....S TMP=$$ADD2ERR^PPPBLD2(ERRARY2,ERRTXT)
57 ...;
58FFXIFN ...; Check to see if the entry already exists. If it does then update
59 ...; the last date of visit if necessary. Else create a new entry.
60 ...;
61 ...S FFXIFN=$$GETFFIFN^PPPGET1(PATDFN,SNIFN)
62 ...S MPDLDOV=$G(@OUTARRY@(SSN,"SITES",STANO))
63 ...I FFXIFN>0 D
64 ....S FFXLDOV=$P($G(^PPP(1020.2,FFXIFN,0)),"^",3)
65 ....I MPDLDOV>FFXLDOV D
66 .....S DIE=1020.2
67 .....S DA=FFXIFN
68 .....S DR="2///"_MPDLDOV
69 .....D ^DIE
70 ....S TEDTENT=TEDTENT+1
71 ...E D
72 ....S X=PATDFN
73 ....S DIC="^PPP(1020.2,"
74 ....S DIC(0)=""
75 ....S DIC("DR")="1////"_SNIFN_";2///"_MPDLDOV_";7///0"
76 ....K DD,DO D FILE^DICN
77 ....S TNEWENT=TNEWENT+1
78 ....I $P(Y,"^",3)'=1 D
79 .....S ERRTXT="Could not add "_SSN_"/"_STANO_" to FFX file."
80 .....S ERRORS=1
81 .....S TMP=$$ADD2ERR^PPPBLD2(ERRARY2,ERRTXT)
82 ....;
83 ....; Make sure the DOMAIN name got resolved.
84 ....;
85 ....I $P($G(^PPP(1020.2,+Y,1)),"^",5)="" D
86 .....S ERRTXT="Could not resolve DOMAIN for "_SSN_"/"_STANO
87 .....S ERRORS=1
88 .....S TMP=$$ADD2ERR^PPPBLD2(ERRARY2,ERRTXT)
89 ..;
90 ..; We're done with that SSN, kill it off and set last SSN processed
91 ..;VMP OIFO BAY PINES;ELR;PPP*1*38
92 ..D DEL
93 ..;
94 ..K @OUTARRY@("DONE",SSN)
95 ..;PPP*1*26 Dave Blocker - remove setting last SSN
96 ..;messes up the build option
97 ..K @OUTARRY@(SSN)
98 ..;S $P(^PPP(1020.1,1,2),"^",1)=SSN
99 ..S STARTTM=$$NOW^PPPCNV1
100 .E D
101 ..;
102 ..; There was no SSN available. Check to see if we're done.
103 ..; If not then check again.
104 ..;
105 ..S STATUS=+$G(@OUTARRY@("STATUS"))
106 ..I STATUS<0 D
107 ...S ERR=MPDSTERR
108 ...S TMP=$$LOGEVNT^PPPMSC1(ERR,PPPMRT,"Status = "_$P($G(@OUTARRY@("STATUS")),U,2))
109 ..E H 1
110 ;
111 ; We're all done. Check to see if we need to send an error bulletin.
112 ;
113 I ERRORS D
114 .S TMP=$$SNDBLTN^PPPMSC1("PPP FFX BUILD MESSAGES","PRESCRIPTION PRACTICES",ERRARY1)
115 ;
116 Q
117 ;
118DEL ;VMP OIFO BAY PINES;ELR;PPP*1*38
119 NEW PPPDA S PPPDA=0
120 F S PPPDA=$O(^PPP(1020.7,"B",SSN,PPPDA)) Q:PPPDA="" D
121 .I PPPDA S DA=PPPDA,DIK="^PPP(1020.7," D ^DIK K DIK
122 Q
Note: See TracBrowser for help on using the repository browser.