source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPSCN1.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: 3.0 KB
Line 
1PPPSCN1 ;ALB/DMB - PPP XREF SCAN ROUTINE ; 2/18/91
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4XREFSCAN ; Scan the FFX file for bad PDX results
5 ;
6 N RSLTPTR,UNSPTR,PROCPTR,AUTOPTR,CODE,ERRORS,LBRD,TMP,XFIFN
7 N XSCNEND,XSCNSTRT
8 ;
9 S PPPMRT="XREFSCAN_PPPSCN1"
10 S XSCNSTRT=1004
11 S XSCNEND=1005
12 S ERRORS=0
13 ;
14 ; Get the IFN's for the PDX Status codes
15 ;
16 S RSLTPTR=$$GETSTPTR^PPPGET7("VAQ-RSLT")
17 S UNSPTR=$$GETSTPTR^PPPGET7("VAQ-UNSOL")
18 S PROCPTR=$$GETSTPTR^PPPGET7("VAQ-PROC")
19 S AUTOPTR=$$GETSTPTR^PPPGET7("VAQ-AUTO")
20 ;
21 S TMP=$$LOGEVNT^PPPMSC1(XSCNSTRT,PPPMRT)
22 S LBRD=$P(^PPP(1020.1,1,0),"^",6)
23 I LBRD'="" D
24 .S ^TMP("PPP",$J,"ERR",1)="The following status were found while running XREFSCAN for last PDX batch"
25 .S ^TMP("PPP",$J,"ERR",2)="dated: "_$$DTE^PPPUTL1(LBRD,0)
26 .S ^TMP("PPP",$J,"ERR",3)=" "
27 .F XFIFN=0:0 D Q:XFIFN=""
28 ..S XFIFN=$O(^PPP(1020.2,"C",LBRD,XFIFN)) Q:XFIFN=""
29 ..S CODE=$P($G(^PPP(1020.2,XFIFN,1)),"^",3)
30 ..I ((CODE'=RSLTPTR)&(CODE'=UNSPTR)&(CODE'=PROCPTR)&(CODE'=AUTOPTR)) D
31 ...S TMP=$$ADD2LIST("^TMP(""PPP"",$J,""ERR"")",XFIFN)
32 ...S ERRORS=1
33 E D
34 .S ^TMP("PPP",$J,"ERR",1)=" "
35 .S ^TMP("PPP",$J,"ERR",2)="Last Batch Request Date Not Found"
36 .S ERRORS=1
37 I ERRORS D
38 .S TMP=$$SNDBLTN^PPPMSC1("PPP - Nightly PDX Result Scan","PRESCRIPTION PRACTICES","^TMP(""PPP"",$J,""ERR"",")
39 S TMP=$$LOGEVNT^PPPMSC1(XSCNEND,PPPMRT)
40 K PPPMRT,^TMP("PPP",$J,"ERR")
41 Q
42 ;
43ADD2LIST(ARRYNM,XRFIFN) ; Add an error to the error list
44 ;
45 N IDX,LKUPERR,PARMERR,PATDFN,PATNAME,SNIFN,STANAME,STATCODE,STATIFN
46 N STATTXT,TMP,FFXDOM
47 ;
48 S PARMERR=-9001
49 S LKUPERR=-9003
50 ;
51 ; Check Parameters
52 ;
53 I '$D(ARRYNM) Q PARMERR
54 I '$D(XRFIFN) Q PARMERR
55 I ARRYNM=""!(XRFIFN<1) Q PARMERR
56 ;
57 ; Get the patient name
58 ;
59 S PATDFN=$P($G(^PPP(1020.2,XRFIFN,0)),"^")
60 I PATDFN="" Q LKUPERR
61 S PATNAME=$$GETPATNM^PPPGET1(PATDFN) Q:PATNAME<0 LKUPERR
62 ;
63 ; Get the station name/domain
64 ;
65 S FFXDOM=$P($G(^PPP(1020.2,XRFIFN,1)),"^",5)
66 S SNIFN=$P($G(^PPP(1020.2,XRFIFN,0)),"^",2)
67 I SNIFN="" Q LKUPERR
68 S STANAME=$$GETSTANM^PPPGET1(SNIFN) Q:STANAME<0 LKUPERR
69 ;
70 ; Get the PDX Status and text from FFX file
71 ;
72 S STATCODE=""
73 S STATTXT=""
74 ;
75 S STATIFN=$P($G(^PPP(1020.2,XRFIFN,1)),"^",3)
76 I STATIFN'="" D
77 .S TMP=$$GETPDXST^PPPGET7(STATIFN)
78 .S STATCODE=$P(TMP,"^",1)
79 .S STATTXT=$P(TMP,"^",2)
80 ;
81 I ((STATCODE="-1")!(STATCODE="")) D CHKPDX
82 I ((STATCODE="-1")!(STATCODE="")) D
83 .S STATCODE="NULL",STATTXT="NOTHING RETURNED"
84 ;
85 ; Set the array
86 ;
87 F IDX=1:1 D Q:TMP=""
88 .S TMP=$O(@ARRYNM@(IDX)) Q:TMP=""
89 S @ARRYNM@(IDX+1)="PDX Status For "_PATNAME_" at "_STANAME_" is: "_STATTXT
90 ;
91 Q 0
92 ;
93CHKPDX ; -- Checks actual PDX when status is not in 1020.2
94 N EXIT,PDXPTR
95 ;
96 S (PDXPTR,EXIT)=0
97 F S PDXPTR=$O(^VAT(394.61,"PATPTR",PATDFN,PDXPTR)) Q:PDXPTR=""!EXIT D
98 .S PDXDOM=$P($G(^VAT(394.61,PDXPTR,"ATHR2")),"^",2)
99 .I PDXDOM=FFXDOM D
100 ..S STATIFN=$P($G(^VAT(394.61,PDXPTR,0)),"^",2)
101 ..S TMP=$$GETPDXST^PPPGET7(STATIFN)
102 ..S STATCODE=$P(TMP,"^",1)
103 ..S STATTXT=$P(TMP,"^",2)
104 ..S EXIT=1
105 ;
106END ; -- End of code
107 Q
108 ;
Note: See TracBrowser for help on using the repository browser.