source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPRT22.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: 2.0 KB
Line 
1PPPPRT22 ;ALB/JFP/DAD - FFX PRINT ROUTINES ; 3/16/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**17**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5STAHISTP ; Print tha station Histogram
6 ;
7 N PPPMRT,PRTFFXST,PRTFFXND
8 N STANUM,VISITS,STARS,PPPARRY,TMP,I,DR,DIR,NUMPATS,NUMVIS,NUMVISIT
9 N VALMVNT,HDRCNT,DROOT,HROOT,X,BLINE
10 ;
11 S PPPMRT="STAHISTP_PPPPRT22"
12 S PRTFFXST=1017
13 S PRTFFXND=1018
14 S (VALMCNT,HDRCNT)=0
15 ;
16 S DROOT="^TMP(""PPPL6"",$J)"
17 S HROOT="^TMP(""PPPL6"",$J,""HDR"")"
18 S PPPARRY="^TMP(""PPP"",$J,""HIST"")"
19 ;
20 S TMP=$$LOGEVNT^PPPMSC1(PRTFFXST,PPPMRT,"STATION HISTOGRAMS")
21 D STAHISTA(PPPARRY)
22 ;
23 D HEADING1
24 D ORDER1
25 S X=$$SETSTR^VALM1(" ","",1,79) D TMP
26 S X=$$SETSTR^VALM1("Listing Complete.","",1,79) D TMP
27 K @PPPARRY
28 S TMP=$$LOGEVNT^PPPMSC1(PRTFFXND,PPPMRT)
29 Q
30 ;
31HEADING1 ; Write the page heading, Pause if a crt.
32 ;
33 S BLINE=$$SETSTR^VALM1(" ","",1,80)
34 ;
35 S X=BLINE D HDRTMP
36 S X=$$CENTER^PPPUTL1(BLINE,"Pharmacy Prescription Practices")
37 D HDRTMP
38 S X=$$CENTER^PPPUTL1(BLINE,"Foreign Facility Histograms")
39 D HDRTMP
40 S X=$$CENTER^PPPUTL1(BLINE,"Stations Vs. Number Of Patients")
41 D HDRTMP
42 S X=$$CENTER^PPPUTL1(BLINE,"As Of --> "_$$I2EDT^PPPCNV1(DT))
43 D HDRTMP
44 Q
45 ;
46ORDER1 ;
47 ;
48 S STANUM=""
49 F TMP=0:0 D Q:STANUM=""
50 .S STANUM=$O(@PPPARRY@(STANUM)) Q:STANUM=""
51 .S VISITS=@PPPARRY@(STANUM)
52 .I VISITS>(IOM-20) S VISITS=(IOM-20)
53 .S STARS=""
54 .F I=1:1:VISITS S STARS=STARS_"*"
55 .S X=$$SETSTR^VALM1($E(STANUM_" ",1,6)_" -|- "_STARS_" ("_@PPPARRY@(STANUM)_")","",1,79)
56 .D TMP
57 Q
58 ;
59STAHISTA(TMPARY) ;
60 ;
61 N STAPTR,STANUM,PATDFN
62 ;
63 F STAPTR=0:0 D Q:STAPTR=""
64 .S STAPTR=$O(^PPP(1020.2,"ARPOV",STAPTR)) Q:STAPTR=""
65 .S STANUM=STAPTR
66 .S @TMPARY@(STANUM)=0
67 .F PATDFN=0:0 D Q:PATDFN=""
68 ..S PATDFN=$O(^PPP(1020.2,"ARPOV",STAPTR,PATDFN)) Q:PATDFN=""
69 ..S @TMPARY@(STANUM)=@TMPARY@(STANUM)+1
70 Q
71 ;
72TMP ; -- Sets up data display array
73 S VALMCNT=VALMCNT+1
74 S @DROOT@(VALMCNT,0)=$E(X,1,79)
75 QUIT
76 ;
77HDRTMP ; -- Sets up header display array
78 S HDRCNT=HDRCNT+1
79 S @HROOT@(HDRCNT)=$E(X,1,79)
80 QUIT
81 ;
Note: See TracBrowser for help on using the repository browser.