source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM9.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.2 KB
Line 
1PSUDEM9 ;BIR/DAM - CPT Codes for Inpatient PTF Record Extract ; 20 DEC 2001
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA's
5 ; Reference to file 45 supported by DBIA 3511
6 ; Reference to file 80.1 supported by DBIA 10083
7 ;
8EN ;EN Called from PSUDEM8
9 D CPTP
10 D P
11 D AO
12 D FIN
13 ;
14 Q
15 ;
16CPTP ;Find CPT pointers for the ^DGPT(D0,"401P" node by $ ordering
17 ;through the ^DGPT(D0,"AP",Pointer) cross reference
18 ;
19 S I=17
20 S PSUAP=0
21 F S PSUAP=$O(^DGPT(PSUC,"AP",PSUAP)) Q:'PSUAP D
22 .N PSUCPT
23 .S PSUCPT=$P($G(^ICD0(PSUAP,0)),U) ;CPT code
24 .I $G(PSUCPT) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)="" ;Set temp global
25 .S I=I+1
26 Q
27 ;
28P ;Find CPT pointers for the ^DGPT(D0,"P" node by $O through
29 ;the ^DGPT(D0,"P","AP6",pointer,D1) cross reference
30 ;
31 S I=22
32 S PSUP=0
33 F S PSUP=$O(^DGPT(PSUC,"P","AP6",PSUP)) Q:'PSUP D
34 .N PSUCPT
35 .S PSUCPT=$P($G(^ICD0(PSUP,0)),U) ;CPT code
36 .I $G(PSUCPT) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)="" ;Set temp global
37 .D DEL
38 .S I=I+1
39 Q
40 ;
41DEL ;Delete duplicates
42 ;
43 F N=17:1:21 I $D(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,N,PSUCPT)) D
44 .K ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)
45 Q
46 ;
47AO ;Find CPT pointers for the ^DGPT(D0,"P" node by $O through
48 ;the ^DGPT(D0,"S","AO",pointer,D1) cross reference.
49 ;
50 S I=27
51 S PSUBP=0
52 F S PSUBP=$O(^DGPT(PSUC,"S","AO",PSUBP)) Q:'PSUBP D
53 .N PSUCPT
54 .S PSUCPT=$P($G(^ICD0(PSUBP,0)),U) ;CPT code
55 .I $G(PSUCPT) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)="" ;Set temp global
56 .D DEL1
57 .S I=I+1
58 Q
59 ;
60DEL1 ;Delete duplicates
61 ;
62 F N=17:1:26 I $D(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,N,PSUCPT)) D
63 .K ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)
64 Q
65 ;
66FIN ;$O through temp global, and set codes into the Inpatient Record
67 ;global, ^XTMP("PSU_"_PSUJOB,"PSUIPV"
68 ;
69 S T=0,N=29
70 F S T=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T)) Q:'T Q:N=44 D
71 .S PSUIDF=0
72 .F S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF)) Q:'PSUIDF D
73 ..S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)=PSUIDF
74 ..S N=N+1
75 ;
76 F N=29:1:44 I '$P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N) D
77 .S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)="" ;Set unfilled pieces to null
78 S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,44)="" ;Place "^" at end of record
79 Q
Note: See TracBrowser for help on using the repository browser.