source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM6.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1PSUDEM6 ;BIR/DAM - CPT Codes for Outpatient Visits Extract ; 20 DEC 2001
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA's
5 ; Reference to file 81 supported by DBIA 2815
6 ;
7EN ;EN Called from PSUDEM3
8 D CPT
9 D FIN
10 ;
11 Q
12 ;
13CPT ;Find CPT codes and place into temp global
14 ;
15 N PSUCPT1
16 I $G(PSUCPT) S PSUCPT1=$P($G(^ICPT(PSUCPT,0)),U)
17 I '$G(PSUCPT) S PSUCPT1="NULL"
18 I (PSUVIEN'="")&(PSUCPT1'="") D
19 .S ^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUCPT1)=""
20 Q
21 ;
22FIN ;$O through temp global, and set codes into the Outpatient Visit
23 ;Encounter global, ^XTMP("PSU_"_PSUJOB,"PSUOPV"
24 ;
25 S PSUIDF=0
26 S I=17
27 F S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUIDF)) Q:'PSUIDF Q:I=27 D
28 .I PSUIDF="NULL" S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=""
29 .I PSUIDF'="NULL" S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=PSUIDF
30 .S I=I+1
31 ;
32 F N=27:1:26 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN)),U,N)="" D
33 .S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,N)=""
34 S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,27)="" ;set closing "^"
35 Q
Note: See TracBrowser for help on using the repository browser.