source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPSCN2.m@ 1470

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1PPPSCN2 ;ALB/DMB - PPP CLINIC SCAN ROUTINE ; 2/20/92
2 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**9,41,42**;APR 7,1995;Build 4
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Reference to GETPLIST^SDAMA202 supported by IA #3869
5 ;Reference to ^SC("AC" supported by IA #4084
6 ;
7FFSCAN ; Scan clinic for patients to send PDX's for
8 ;
9 N X,TMP,DTCERR,PFGERR,CSCNSTRT,CSCNEND,DATE,SCANDATE,PCSD,TOTPATS
10 N PDXSTRT,PDXEND,CODE,ERR,FFXIFN,LPDX,MAXDAYS,RSLTPTR,UNSPTR
11 N PATDFN,STAPTR,TOTSTA,X1,X2,PROCPTR,AUTOPTR
12 ;
13 S PPPMRT="FFSCAN_PPPSCN2"
14 S DTCERR=-9006
15 S PFGERR=-9007
16 S CSCNSTRT=1006
17 S CSCNEND=1007
18 S PDXSTRT=1008
19 S PDXEND=1009
20 S ^TMP("PPP",$J,"ERR",1)="The following Errors occurred while attempting to send PDX's:"
21 S ^TMP("PPP",$J,"ERR",2)=" "
22 S (PDXSNT,TOTSTA)=0
23 S ERR=0
24 ;GET POINTERS TO ACCEPTABLE PDX STATUSES
25 S RSLTPTR=$$GETSTPTR^PPPGET7("VAQ-RSLT")
26 S UNSPTR=$$GETSTPTR^PPPGET7("VAQ-UNSOL")
27 S PROCPTR=$$GETSTPTR^PPPGET7("VAQ-PROC")
28 S AUTOPTR=$$GETSTPTR^PPPGET7("VAQ-AUTO")
29 ;
30 S TMP=$$LOGEVNT^PPPMSC1(CSCNSTRT,PPPMRT)
31 ;
32 D NOW^%DTC
33 I X="" D Q
34 .S TMP=$$LOGEVNT^PPPMSC1(DTCERR,PPPMRT)
35 S DATE=X
36 K %,%H,%I,X
37 ;
38 S PCSD=$P($G(^PPP(1020.1,1,0)),"^",2)
39 I PCSD="" D Q
40 .S TMP=$$LOGEVNT^PPPMSC1(PFGERR,PPPMRT)
41 S X1=DATE
42 S X2=PCSD
43 D C^%DTC
44 I X="" D Q
45 .S TMP=$$LOGEVNT^PPPMSC1(DTCERR,PPPMRT)
46 S SCANDATE=X
47 K X1,X2,X,%H
48 ;
49 S TOTPATS=$$CLINSCAN(SCANDATE,"^TMP(""PPP"",$J,SCANDATE)")
50 S TMP=$$LOGEVNT^PPPMSC1(CSCNEND,PPPMRT,"TOTAL ENTRIES = "_TOTPATS)
51 ;
52 S MAXDAYS=$P($G(^PPP(1020.1,1,0)),"^",3)
53 S TMP=$$LOGEVNT^PPPMSC1(PDXSTRT,PPPMRT)
54 ;
55 F PATDFN=0:0 D Q:PATDFN=""
56 .K PPPSTA
57 .S PATDFN=$O(^TMP("PPP",$J,SCANDATE,PATDFN)) Q:PATDFN=""
58 .F STAPTR=0:0 D Q:STAPTR=""
59 ..S STAPTR=$O(^PPP(1020.2,"APOV",PATDFN,STAPTR)) Q:STAPTR=""
60 ..S FFXIFN=$O(^PPP(1020.2,"APOV",PATDFN,STAPTR,"")) Q:FFXIFN=""
61 ..I '$D(^PPP(1020.5,"B",STAPTR)) D
62 ...S LPDX=$P($G(^PPP(1020.2,FFXIFN,1)),"^",2)
63 ...I LPDX=""!($$DIFFDT^PPPCNV1(DATE,LPDX)>MAXDAYS) D
64 ....S CODE=$P($G(^PPP(1020.2,FFXIFN,1)),"^",3)
65 ....I ((CODE=RSLTPTR)!(CODE=UNSPTR)!(CODE=PROCPTR)!(CODE=AUTOPTR)!(CODE="")) D
66 .....S PPPSTA(STAPTR)=""
67 .....S TOTSTA=TOTSTA+1
68 .I $O(PPPSTA(""))'="" D Q:ERR
69 ..S ERR=$$SNDPDX^PPPPDX1(PATDFN,"PPPSTA","^TMP(""PPP"",$J,""ERR"")")
70 ..I ERR D
71 ...S TMP=$$LOGEVNT^PPPMSC1(ERR,PPPMRT,"Error From PPPPDX1 ==> "_ERR)
72 ...S PATDFN=""
73 ;
74 ; Set the last batch request date to today
75 ;
76 S $P(^PPP(1020.1,1,0),"^",6)=DT
77 S TMP=$$LOGEVNT^PPPMSC1(PDXEND,PPPMRT,"TOTAL PDX'S REQUESTED = "_TOTSTA)
78 I '$D(^TMP("PPP",$J,"ERR",3)) S ^TMP("PPP",$J,"ERR",1)="No Errors occurred while attempting to send PDX's"
79 ;S ^TMP("PPP",$J,"ERR",4)=""
80 S TMP=$$SNDBLTN^PPPMSC1("PPP DAILY BATCH "_$$SLASHDT^PPPCNV1(DT),"PRESCRIPTION PRACTICES","^TMP(""PPP"",$J,""ERR"",")
81 ;
82 K ^TMP("PPP",$J,"ERR"),^TMP("PPP",$J,SCANDATE),PPPMRT,PPPSTA,PDXSNT
83 Q
84 ;
85CLINSCAN(SCANDATE,ARRYNM) ; Scan the clinics for appointments
86 N CLINIC,PATDFN,TPATS,SEQ
87 ;
88 S CLINIC="",TPATS=0
89 F S CLINIC=$O(^SC("AC","C",CLINIC)) Q:CLINIC="" D
90 .K ^TMP($J,"SDAMA202","GETPLIST")
91 .D GETPLIST^SDAMA202(CLINIC,"3;4;12",,SCANDATE,SCANDATE)
92 .S SEQ=0
93 .F S SEQ=$O(^TMP($J,"SDAMA202","GETPLIST",SEQ)) Q:'SEQ D
94 ..I $P($G(^TMP($J,"SDAMA202","GETPLIST",SEQ,3)),"^")="R",$P($G(^TMP($J,"SDAMA202","GETPLIST",SEQ,12)),"^")="O" D
95 ...S PATDFN=+$G(^TMP($J,"SDAMA202","GETPLIST",SEQ,4)) Q:'PATDFN
96 ...S @ARRYNM@(PATDFN)=""
97 ...S TPATS=TPATS+1
98 K ^TMP($J,"SDAMA202","GETPLIST")
99 ;
100 Q TPATS
Note: See TracBrowser for help on using the repository browser.