| [613] | 1 | PSUDEM9 ;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 | ;
|
|---|
| 8 | EN ;EN Called from PSUDEM8
|
|---|
| 9 | D CPTP
|
|---|
| 10 | D P
|
|---|
| 11 | D AO
|
|---|
| 12 | D FIN
|
|---|
| 13 | ;
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | CPTP ;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 | ;
|
|---|
| 28 | P ;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 | ;
|
|---|
| 41 | DEL ;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 | ;
|
|---|
| 47 | AO ;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 | ;
|
|---|
| 60 | DEL1 ;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 | ;
|
|---|
| 66 | FIN ;$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
|
|---|
