- 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
- 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
