PSUDEM3 ;BIR/DAM - ICD9 codes for Outpatient Encounter Extract ; 20 DEC 2001
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA's
; Reference to file 80 supported by DBIA 10082
; Reference to file 9000010.18 supported by DBIA 3560
;
EN ;EN Called from PSUDEM2
D ICD
D CLEAN
Q
;
ICD ;Find all ICD9 pointers associated with Patient pointer
;
N PSUICD
S PSUC1=0
F S PSUC1=$O(^AUPNVCPT("C",PSUPT,PSUC1)) Q:PSUC1="" D ;V CPT IEN
.I $P($G(^AUPNVCPT(PSUC1,0)),U,3)=$G(PSUVIEN) D ;V CPT IEN=Visit IEN
..S PSUICD=$P($G(^AUPNVCPT(PSUC1,0)),U,5) D ICD1 ;ICD9 Ptr
..S PSUCPT=$P($G(^AUPNVCPT(PSUC1,0)),U,1) D EN^PSUDEM6 ;grab CPT codes
I '$D(^AUPNVCPT("C",PSUPT)) S PSUCPT="" D EN^PSUDEM6
D FIN
Q
;
ICD1 ;Find ICD9 codes from pointers and place in an array
;
;
N PSUID2
I PSUICD S PSUID2=$P($G(^ICD9(PSUICD,0)),U) D
.I $D(PSUID2) S ^XTMP("PSU_"_PSUJOB,"PSUTMP1",PSUVIEN,PSUID2)="" ;ICD9 codes set into array
;
Q
;
FIN ;$O through array, and set codes into the Outpatient Visit
;Encounter global, ^XTMP("PSU_"_PSUJOB,"PSUOPV"
;
;
S PSUIDF=0
S I=8
F S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP1",PSUVIEN,PSUIDF)) Q:'PSUIDF Q:I=17 D
.S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=PSUIDF
.S I=I+1
;
F N=8:1:16 I '$P($G(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN)),U,N) D
.S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,N)=""
Q
;
CLEAN ;Delete all ^XTMP("PSU_"_PSUJOB,"PSUOPV" entries that do not have associated
;ICD9 or CPT codes.
;
S PSUCL=0
F S PSUCL=$O(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL)) Q:'PSUCL D
.I $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL),U,7)="" D
..I $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL),U,17)="" K ^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUDEM3 1767 printed Sep 23, 2025@20:03:24 Page 2
PSUDEM3 ;BIR/DAM - ICD9 codes for Outpatient Encounter Extract ; 20 DEC 2001
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA's
+4 ; Reference to file 80 supported by DBIA 10082
+5 ; Reference to file 9000010.18 supported by DBIA 3560
+6 ;
EN ;EN Called from PSUDEM2
+1 DO ICD
+2 DO CLEAN
+3 QUIT
+4 ;
ICD ;Find all ICD9 pointers associated with Patient pointer
+1 ;
+2 NEW PSUICD
+3 SET PSUC1=0
+4 ;V CPT IEN
FOR
SET PSUC1=$ORDER(^AUPNVCPT("C",PSUPT,PSUC1))
if PSUC1=""
QUIT
Begin DoDot:1
+5 ;V CPT IEN=Visit IEN
IF $PIECE($GET(^AUPNVCPT(PSUC1,0)),U,3)=$GET(PSUVIEN)
Begin DoDot:2
+6 ;ICD9 Ptr
SET PSUICD=$PIECE($GET(^AUPNVCPT(PSUC1,0)),U,5)
DO ICD1
+7 ;grab CPT codes
SET PSUCPT=$PIECE($GET(^AUPNVCPT(PSUC1,0)),U,1)
DO EN^PSUDEM6
End DoDot:2
End DoDot:1
+8 IF '$DATA(^AUPNVCPT("C",PSUPT))
SET PSUCPT=""
DO EN^PSUDEM6
+9 DO FIN
+10 QUIT
+11 ;
ICD1 ;Find ICD9 codes from pointers and place in an array
+1 ;
+2 ;
+3 NEW PSUID2
+4 IF PSUICD
SET PSUID2=$PIECE($GET(^ICD9(PSUICD,0)),U)
Begin DoDot:1
+5 ;ICD9 codes set into array
IF $DATA(PSUID2)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP1",PSUVIEN,PSUID2)=""
End DoDot:1
+6 ;
+7 QUIT
+8 ;
FIN ;$O through array, and set codes into the Outpatient Visit
+1 ;Encounter global, ^XTMP("PSU_"_PSUJOB,"PSUOPV"
+2 ;
+3 ;
+4 SET PSUIDF=0
+5 SET I=8
+6 FOR
SET PSUIDF=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP1",PSUVIEN,PSUIDF))
if 'PSUIDF
QUIT
if I=17
QUIT
Begin DoDot:1
+7 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=PSUIDF
+8 SET I=I+1
End DoDot:1
+9 ;
+10 FOR N=8:1:16
IF '$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN)),U,N)
Begin DoDot:1
+11 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,N)=""
End DoDot:1
+12 QUIT
+13 ;
CLEAN ;Delete all ^XTMP("PSU_"_PSUJOB,"PSUOPV" entries that do not have associated
+1 ;ICD9 or CPT codes.
+2 ;
+3 SET PSUCL=0
+4 FOR
SET PSUCL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL))
if 'PSUCL
QUIT
Begin DoDot:1
+5 IF $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL),U,7)=""
Begin DoDot:2
+6 IF $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL),U,17)=""
KILL ^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUCL)
End DoDot:2
End DoDot:1
+7 QUIT
