source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPBLD5.m@ 1739

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1PPPBLD5 ;ALB/DMB - ADD NEW PATS TO FFX FROM CDROM ; 5/14/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5NEWSSN ;
6 ; This routine is intended to be a background task which
7 ; checks a new SSN against MDP. It is called via a MUMPS
8 ; cross-reference on the SSN field of the NEW SSN File.
9 ; It expects to have the variables PPPSSN and PPPIFN
10 ; defined on input.
11 ;
12 ; PPPSSN = The new SSN being added
13 ; PPPIFN = The entry number for that SSN in teh New SSN file
14 ;
15 N BFFXEND,BFFXSTRT,EXCARRY,INARRY,OUTARRY,LKUPERR,TMP,RESULT
16 N LOGMSG,STANO,UCI,ZERONODE,NOSSNERR,LSTPROC
17 ;
18 S PPPMRT="NEWSSN_PPPBLD5"
19 S LKUPERR=-9003
20 S NOSSNERR=-9017
21 S BFFXSTRT=1012
22 S BFFXEND=1013
23 S LSTPROC=""
24 ;
25 ; Initialize the input, output and exclusion arrays.
26 ; Note: Leave off the ^ as we will add it later.
27 ;
28 S INARRY="TMP(""PPP"","_$J_",""IN"")"
29 S OUTARRY="TMP(""PPP"","_$J_",""OUT"")"
30 S EXCARRY="TMP(""PPP"","_$J_",""EXC"")"
31 ;
32 ; Log start of routine.
33 ;
34 S TMP=$$LOGEVNT^PPPMSC1(BFFXSTRT,PPPMRT)
35 ;
36 ; Get the station number from the parameter file.
37 ;
38 S STANO=$P($G(^PPP(1020.1,1,0)),"^",9)
39 I STANO="" D Q
40 .S TMP=$$LOGEVNT^PPPMSC1(LKUPERR,PPPMRT,"Station Number Not Found")
41 .S PPPTMP(1)="CDROM^PPPBLD3 -> Station Number Not In Parameter File"
42 .S TMP=$$SNDBLTN^PPPMSC1("PPP NOTIFICATION","PRESCRIPTION PRACTICES","PPPTMP(")
43 .K PPPMRT,PPPTMP
44 ;
45 ; Get the UCI from Parameter File.
46 ;
47 S UCI=$$GETUCI^PPPGET3("TMP")
48 I UCI="" D Q
49 .S TMP=$$LOGEVNT^PPPMSC1(LKUPERR,PPPMRT,"UCI Not Found")
50 .S PPPTMP(1)="CDROM^PPPBLD3 -> UCI not available via Kernel call."
51 .S TMP=$$SNDBLTN^PPPMSC1("PPP NOTIFICATION","PRESCRIPTION PRACTICES","PPPTMP(")
52 .K PPPMRT,PPPTMP
53 ;
54 ; Build the required variables
55 ;
56 S INARRY="^"_UCI_INARRY
57 S OUTARRY="^"_UCI_OUTARRY
58 S EXCARRY="^"_UCI_EXCARRY
59 S @EXCARRY@(STANO)=""
60 ;
61 ; Check for SSN's to process
62 ;
63 I '$D(PPPSSN) D Q
64 .S TMP=$$LOGEVNT^PPPMSC1(NOSSNERR,PPPMRT)
65 .K PPPMRT
66 ;
67 ; Copy the New SSN File to the inarry.
68 ;
69 K @INARRY
70 S @INARRY@(PPPSSN)=""
71 ;
72 ; Now call the build routine.
73 ;
74 S RESULT=$$BFFX^PPPBLD1(INARRY,OUTARRY,EXCARRY,LSTPROC)
75 I +RESULT'<0 D
76 .;
77 .; Get the station numbers from the FFX file and send PDX's
78 .;
79 .S PATDFN=+$$GETDFN^PPPGET1(PPPSSN)
80 .K PPPTMP,PPPERR
81 .S TMP=$$BSA(PATDFN,"PPPTMP")
82 .S PPPERR(1)="An error occurred while attempting to send a PDX from NEWSSN."
83 .S PPPERR(2)=""
84 .S TMP=$$SNDPDX^PPPPDX1(PATDFN,"PPPTMP","PPPERR")
85 .I $D(PPPERR(3)) D
86 ..S TMP=$$SNDBLTN^PPPMSC1("PPP NOTIFICATION","PRESCRIPTION PRACTICES","PPPERR(")
87 .S TMP=$$STATUPDT^PPPMSC1(8,1)
88 .K PPPTMP,PPPERR
89 .;
90 .; Kill the entry in the NEWSSN file.
91 .;
92 .S DIK="^PPP(1020.7,"
93 .S DA=PPPIFN
94 .D ^DIK
95 ;
96 ; Log the end of the routine.
97 ;
98 S LOGMSG="Result: "_$P(RESULT,"^")_", New Entries: "_$P(RESULT,"^",2)_", Edited Entries: "_$P(RESULT,"^",3)
99 S TMP=$$LOGEVNT^PPPMSC1(BFFXEND,PPPMRT,LOGMSG)
100 K PPPSSN,PPPIFN,PPPMRT,PPPTMP,@INARRY,@OUTARRY,@EXCARRY
101 Q
102 ;
103BSA(PATDFN,STARRAY) ; Build the station array
104 ;
105 N TOTSTA,STAPTR,FFXIFN
106 ;
107 S TOTSTA=0
108 F STAPTR=0:0 S STAPTR=$O(^PPP(1020.2,"APOV",PATDFN,STAPTR)) Q:STAPTR="" D
109 .S FFXIFN=$O(^PPP(1020.2,"APOV",PATDFN,STAPTR,"")) Q:FFXIFN=""
110 .I '$D(^PPP(1020.5,"B",STAPTR)) S @STARRAY@(STAPTR)="",TOTSTA=TOTSTA+1
111 Q TOTSTA
Note: See TracBrowser for help on using the repository browser.