source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPRT4.m@ 771

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1PPPPRT4 ;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 ;
5SRTBYNM(OUTARRY) ; Sort the FFX file by name
6 ;
7 ; This function will order through the APOV xref of the FFX file
8 ; and return an array containing the patient info and place of visit
9 ; info.
10 ;
11 ; The output array is in the form:
12 ;
13 ; @OUTARRY@(PATIENT_NAME)=DOB^SSN
14 ; @OUTARRY@(PATIENT_NAME,STATION_NAME)=NUMBER^DOMAIN^LDOV
15 ;
16 N DIC,DA,PATDFN,DR,DIQ,PATNAME,PATDOB,PATSSN,PPPTMP,STANAME,STANUM
17 N STADOM,LDOV,TPATS,TSTATION,SNIFN,FFXIFN
18 ;
19 K @OUTARRY
20 ;
21 S TPATS=0
22 S TSTATION=0
23 ;
24 ; Order through the APOV xref and get the data for each dfn
25 ;
26 F PATDFN=0:0 D Q:PATDFN=""
27 .S PATDFN=$O(^PPP(1020.2,"APOV",PATDFN)) Q:PATDFN=""
28 .S DIC=2,DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP"
29 .D EN^DIQ1 Q:'$D(PPPTMP)
30 .S PATNAME=PPPTMP(2,PATDFN,.01)
31 .S PATDOB=PPPTMP(2,PATDFN,.03)
32 .S PATSSN=PPPTMP(2,PATDFN,.09)
33 .S @OUTARRY@(PATNAME)=PATDOB_"^"_PATSSN
34 .S TPATS=TPATS+1
35 .K PPPTMP
36 .F SNIFN=0:0 D Q:SNIFN=""
37 ..S SNIFN=$O(^PPP(1020.2,"APOV",PATDFN,SNIFN)) Q:SNIFN=""
38 ..S FFXIFN=$O(^PPP(1020.2,"APOV",PATDFN,SNIFN,"")) Q:FFXIFN=""
39 ..S DIC=4,DA=SNIFN,DR=".01;99",DIQ="PPPTMP"
40 ..D EN^DIQ1 Q:'$D(PPPTMP)
41 ..S STANAME=PPPTMP(4,SNIFN,.01)
42 ..S STANUM=PPPTMP(4,SNIFN,99)
43 ..K PPPTMP
44 ..S LDOV=$$I2EDT^PPPCNV1($P($G(^PPP(1020.2,FFXIFN,0)),"^",3))
45 ..S STADOM=$P($G(^PPP(1020.2,FFXIFN,1)),"^",5)
46 ..S @OUTARRY@(PATNAME,STANAME)=STANUM_"^"_STADOM_"^"_LDOV
47 ..S TSTATION=TSTATION+1
48 Q TPATS_"^"_TSTATION
49 ;
50SRTBYSTA(OUTARRY) ; Sort the FFX file by STATION
51 ;
52 ; This function will order through the ARPOV xref of the FFX file
53 ; and return an array containing the patient info and place of visit
54 ; info.
55 ;
56 ; The output array is in the form:
57 ;
58 ; @OUTARRY@(STATION_NAME)=NUMBER^DOMAIN
59 ; @OUTARRY@(STATION_NAME_PATIENT_NAME)=DOB^SSN^LDOV
60 ;
61 N DIC,DA,PATDFN,DR,DIQ,PATNAME,PATDOB,PATSSN,PPPTMP,STANAME,STANUM
62 N STADOM,LDOV,TPATS,TSTATION,SNIFN,FFXIFN
63 ;
64 K @OUTARRY
65 ;
66 S TPATS=0
67 S TSTATION=0
68 ;
69 ; Order through the ARPOV xref and get the data for each dfn
70 ;
71 F SNIFN=0:0 D Q:SNIFN=""
72 .S SNIFN=$O(^PPP(1020.2,"ARPOV",SNIFN)) Q:SNIFN=""
73 .S DIC=4,DA=SNIFN,DR=".01;99",DIQ="PPPTMP"
74 .D EN^DIQ1 Q:'$D(PPPTMP)
75 .S STANAME=PPPTMP(4,SNIFN,.01)
76 .S STANUM=PPPTMP(4,SNIFN,99)
77 .K PPPTMP
78 .S TSTATION=TSTATION+1
79 .F PATDFN=0:0 D Q:PATDFN=""
80 ..S PATDFN=$O(^PPP(1020.2,"ARPOV",SNIFN,PATDFN)) Q:PATDFN=""
81 ..S DIC=2,DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP"
82 ..D EN^DIQ1 Q:'$D(PPPTMP)
83 ..S PATNAME=PPPTMP(2,PATDFN,.01)
84 ..S PATDOB=PPPTMP(2,PATDFN,.03)
85 ..S PATSSN=PPPTMP(2,PATDFN,.09)
86 ..S FFXIFN=$O(^PPP(1020.2,"ARPOV",SNIFN,PATDFN,"")) Q:FFXIFN=""
87 ..S LDOV=$$I2EDT^PPPCNV1($P($G(^PPP(1020.2,FFXIFN,0)),"^",3))
88 ..S STADOM=$P($G(^PPP(1020.2,FFXIFN,1)),"^",5)
89 ..S @OUTARRY@(STANAME)=STANUM_"^"_STADOM
90 ..S @OUTARRY@(STANAME,PATNAME)=PATDOB_"^"_PATSSN_"^"_LDOV
91 ..S TPATS=TPATS+1
92 ..K PPPTMP
93 Q TSTATION_"^"_TPATS
94 ;
95NAMESRT(INARRY,OUTARRY) ; Sort the clinic list by name and get SSN & DOB.
96 ;
97 N DIC,DA,PATDFN,DR,DIQ,NAME,DOB,SSN,PPPTMP
98 ;
99 ; Make sure the output array is empty
100 ;
101 K @OUTARRY,PPPTMP
102 ;
103 S TENTRY=0
104 ;
105 ; Order through the in array and get the data for each DFN.
106 ;
107 F PATDFN=0:0 D Q:PATDFN=""
108 .S PATDFN=$O(@INARRY@(PATDFN)) Q:PATDFN=""
109 .S DIC=2,DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP"
110 .D EN^DIQ1 Q:'$D(PPPTMP)
111 .S NAME=PPPTMP(2,PATDFN,.01)
112 .S DOB=PPPTMP(2,PATDFN,.03)
113 .S SSN=PPPTMP(2,PATDFN,.09)
114 .S @OUTARRY@(NAME,PATDFN)=DOB_"^"_SSN
115 .S TENTRY=TENTRY+1
116 .K PPPTMP
117 Q TENTRY
Note: See TracBrowser for help on using the repository browser.