source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPRT20.m@ 701

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1PPPPRT20 ;ALB/DMB - FFX PRINT ROUTINES ; 3/13/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PRTBYNM ; Print the FFX file by name
6 ;
7 N PPPARRY,PPPMRT,DROOT,HROOT,PRTFFXST,PRTFFXND,BLINE,X,TMP
8 N PATNAME,PATINFO,PATDOB,PATSSN
9 N STANAME,STAINFO,STANUM,DOMAIN,LDOV
10 N HDRCNT
11 ;
12 S (VALMCNT,HDRCNT)=0
13 ;
14 S DROOT="^TMP(""PPPL6"",$J)"
15 S HROOT="^TMP(""PPPL6"",$J,""HDR"")"
16 S PPPARRY="^TMP(""PPP"",$J,""SRT"")"
17 ;
18 K @DROOT,@HROOT,@PPPARRY
19 ;
20 S PPPMRT="PRTBYNM_PPPPRT20"
21 S PRTFFXST=1017
22 S PRTFFXND=1018
23 ;
24 S TMP=$$LOGEVNT^PPPMSC1(PRTFFXST,PPPMRT)
25 ;
26 D HDR1
27 S TMP=$$SRTBYNM^PPPPRT4(PPPARRY) ; -- Sorts data
28 D ORDER1
29 S TMP=$$LOGEVNT^PPPMSC1(PRTFFXND,PPPMRT)
30 ; -- Clean up
31 K DIR,DIE
32 K @PPPARRY
33 Q
34 ;
35HDR1 ; -- Writes heading
36 S BLINE=$$SETSTR^VALM1(" ","",1,80)
37 ;
38 S X=$$CENTER^PPPUTL1(BLINE,"PPP Foreign Facility Xref File")
39 D TMPHDR
40 S X=$$CENTER^PPPUTL1(BLINE,"by patient as of --> "_$$I2EDT^PPPCNV1(DT))
41 D TMPHDR
42 S X=" " D TMPHDR
43 S X=$$SETSTR^VALM1("PATIENT NAME","",1,40)
44 S X=$$SETSTR^VALM1("SSN",X,41,20)
45 S X=$$SETSTR^VALM1("DOB",X,61,20)
46 D TMPHDR
47 S X=$$SETSTR^VALM1("FACILITY NAME","",2,30)
48 S X=$$SETSTR^VALM1("NUMBER",X,31,10)
49 S X=$$SETSTR^VALM1("DOMAIN",X,41,20)
50 S X=$$SETSTR^VALM1("LAST VISIT",X,61,20)
51 D TMPHDR
52 QUIT
53 ;
54ORDER1 ; -- Line 1
55 ;
56 S PATNAME=""
57 F D Q:PATNAME=""
58 .S PATNAME=$O(@PPPARRY@(PATNAME)) Q:PATNAME=""
59 .S PATINFO=@PPPARRY@(PATNAME) Q:PATINFO=""
60 .S PATDOB=$P(PATINFO,"^")
61 .S PATSSN=$P(PATINFO,"^",2)
62 .S X=$$SETSTR^VALM1(PATNAME,"",1,40)
63 .S X=$$SETSTR^VALM1($E(PATSSN,1,3)_"-"_$E(PATSSN,4,5)_"-"_$E(PATSSN,6,9),X,41,20)
64 .S X=$$SETSTR^VALM1(PATDOB,X,61,20)
65 .D TMP
66ORDER2 .; -- Line 2
67 .;
68 .S STANAME=""
69 .F D Q:STANAME=""
70 ..S STANAME=$O(@PPPARRY@(PATNAME,STANAME)) Q:STANAME=""
71 ..S STAINFO=@PPPARRY@(PATNAME,STANAME) Q:STAINFO=""
72 ..S STANUM=$P(STAINFO,"^")
73 ..S DOMAIN=$E($P(STAINFO,"^",2),1,18)
74 ..S LDOV=$P(STAINFO,"^",3)
75 ..S X=$$SETSTR^VALM1($E(STANAME,1,25),"",2,30)
76 ..S X=$$SETSTR^VALM1(STANUM,X,31,10)
77 ..S X=$$SETSTR^VALM1(DOMAIN,X,41,20)
78 ..S X=$$SETSTR^VALM1(LDOV,X,61,20)
79 ..D TMP
80 .S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
81 Q
82 ;
83TMP ; -- Sets up data display array
84 S VALMCNT=VALMCNT+1
85 S @DROOT@(VALMCNT,0)=$E(X,1,79)
86 QUIT
87 ;
88TMPHDR ; -- Sets up header display array
89 S HDRCNT=HDRCNT+1
90 S @HROOT@(HDRCNT)=$E(X,1,79)
91 QUIT
92 ;
Note: See TracBrowser for help on using the repository browser.