PSUDEM8 ;BIR/DAM - ICD9 Codes for Inpatient PTF Record Extract ; 20 DEC 2001
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA's
; Reference to file 45 supported by DBIA 3511
; Reference to file 80 supported by DBIA 10082
;
EN ;EN CALLED FROM PSUDEM7
D PTFIEN
Q
;
PTFIEN ;$O through ^XTMP("PSU_"_PSUJOB,"PSUIPV" to get all the PTF IEN's
;
S PSUC=0
F S PSUC=$O(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC)) Q:'PSUC D
.D PTF70 ;gather ICD9 data on ^DGPT(D0,70 node
.D PTFM ;gather ICD9 data on ^DGPT(D0,"M","AC" node
.D FIN K ^XTMP("PSU_"_PSUJOB,"PSUTMP3")
.D EN^PSUDEM9 ;gather CPT data on 2 separate ^DGPT nodes
Q
;
PTF70 ;Find all ICD9 pointers present on ^DGPT(D0,70 node
;
N PSU1,PSU2,PSU3,PSU4,PSU5,PSU6,PSU7,PSU8,PSU9,PSU10,PSU11
S PSU1=$P($G(^DGPT(PSUC,70)),U,10) S:PSU1="" PSU1="NULL" ;Ptr 1
S PSU2=$P($G(^DGPT(PSUC,70)),U,16) S:PSU2="" PSU2="NULL" ;Ptr 2
S PSU3=$P($G(^DGPT(PSUC,70)),U,17) S:PSU3="" PSU3="NULL" ;Ptr 3
S PSU4=$P($G(^DGPT(PSUC,70)),U,18) S:PSU4="" PSU4="NULL" ;Ptr 4
S PSU5=$P($G(^DGPT(PSUC,70)),U,19) S:PSU5="" PSU5="NULL" ;Ptr 5
S PSU6=$P($G(^DGPT(PSUC,70)),U,20) S:PSU6="" PSU6="NULL" ;Ptr 6
S PSU7=$P($G(^DGPT(PSUC,70)),U,21) S:PSU7="" PSU7="NULL" ;Ptr 7
S PSU8=$P($G(^DGPT(PSUC,70)),U,22) S:PSU8="" PSU8="NULL" ;Ptr 8
S PSU9=$P($G(^DGPT(PSUC,70)),U,23) S:PSU9="" PSU9="NULL" ;Ptr 9
S PSU10=$P($G(^DGPT(PSUC,70)),U,24) S:PSU10="" PSU10="NULL" ;Ptr 10
S PSU11=$P($G(^DGPT(PSUC,70)),U,11) S:PSU11="" PSU11="NULL" ;Ptr 11
D ICD91
Q
;
ICD91 ;Find ICD9 codes from pointer on ^DGPT(D0,70 node and place in
;an array
;
N PSUID1,PSUID2,PSUID3,PSUID4,PSUID5,PSUID6,PSUID7,PSUID8,PSUID9
N PSUID10,PSUID11
S:PSU1'["N" PSUID1=$P($G(^ICD9(PSU1,0)),U) D
.I $D(PSUID1) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,1,PSUID1)="" ;1ST ICD9 CODE
S:PSU2'["N" PSUID2=$P($G(^ICD9(PSU2,0)),U) D
.I $D(PSUID2) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,2,PSUID2)="" ;2ND ICD9 CODE
S:PSU3'["N" PSUID3=$P($G(^ICD9(PSU3,0)),U) D
.I $D(PSUID3) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,3,PSUID3)="" ;3rd ICD9 CODE
S:PSU4'["N" PSUID4=$P($G(^ICD9(PSU4,0)),U) D
.I $D(PSUID4) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,4,PSUID4)="" ;4th ICD9 CODE
S:PSU5'["N" PSUID5=$P($G(^ICD9(PSU5,0)),U) D
.I $D(PSUID5) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,5,PSUID5)="" ;5th ICD9 CODE
S:PSU6'["N" PSUID6=$P($G(^ICD9(PSU6,0)),U) D
.I $D(PSUID6) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,6,PSUID6)="" ;6th ICD9 CODE
S:PSU7'["N" PSUID7=$P($G(^ICD9(PSU7,0)),U) D
.I $D(PSUID7) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,7,PSUID7)="" ;7th ICD9 CODE
S:PSU8'["N" PSUID8=$P($G(^ICD9(PSU8,0)),U) D
.I $D(PSUID8) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,8,PSUID8)="" ;8th ICD9 CODE
S:PSU9'["N" PSUID9=$P($G(^ICD9(PSU9,0)),U) D
.I $D(PSUID9) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,9,PSUID9)="" ;9th ICD9 CODE
S:PSU10'["N" PSUID10=$P($G(^ICD9(PSU10,0)),U) D
.I $D(PSUID10) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,10,PSUID10)="" ;10th ICD9 CODE
S:PSU11'["N" PSUID11=$P($G(^ICD9(PSU11,0)),U) D
.I $D(PSUID11) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,11,PSUID11)="" ;11th ICD9 CODE
Q
;
PTFM ;
S PSUCD=0
S I=12
F S PSUCD=$O(^DGPT(PSUC,"M","AC",PSUCD)) Q:'PSUCD D
.I PSUCD="" S PSUCD="N"
.N PSUIDT
.S PSUIDT=$P($G(^ICD9(PSUCD,0)),U) D
..S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUIDT)=""
..D DEL
..S I=I+1
Q
;
DEL ;Delete duplicates
;
F N=1:1:10 I $D(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,N,PSUIDT)) D
.K ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUIDT)
Q
;
FIN ;$O through array, and set codes into the Inpatient Record
;global ^XTMP("PSU_"_PSUJOB,"PSUIPV"
;
S T=0,N=8
F S T=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T)) Q:'T Q:N=29 D
.S PSUIDF=0
.F S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF)) Q:'PSUIDF D
..S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)=PSUIDF
..S N=N+1
;
F N=8:1:28 I '$P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N) D
.S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)="" ;Set unfilled pieces to null
Q
PSUDEM8 ;BIR/DAM - ICD9 Codes for Inpatient PTF Record Extract ; 20 DEC 2001
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA's
+4 ; Reference to file 45 supported by DBIA 3511
+5 ; Reference to file 80 supported by DBIA 10082
+6 ;
EN ;EN CALLED FROM PSUDEM7
+1 DO PTFIEN
+2 QUIT
+3 ;
PTFIEN ;$O through ^XTMP("PSU_"_PSUJOB,"PSUIPV" to get all the PTF IEN's
+1 ;
+2 SET PSUC=0
+3 FOR
SET PSUC=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC))
IF 'PSUC
QUIT
Begin DoDot:1
+4 ;gather ICD9 data on ^DGPT(D0,70 node
DO PTF70
+5 ;gather ICD9 data on ^DGPT(D0,"M","AC" node
DO PTFM
+6 DO FIN
KILL ^XTMP("PSU_"_PSUJOB,"PSUTMP3")
+7 ;gather CPT data on 2 separate ^DGPT nodes
DO EN^PSUDEM9
End DoDot:1
+8 QUIT
+9 ;
PTF70 ;Find all ICD9 pointers present on ^DGPT(D0,70 node
+1 ;
+2 NEW PSU1,PSU2,PSU3,PSU4,PSU5,PSU6,PSU7,PSU8,PSU9,PSU10,PSU11
+3 ;Ptr 1
SET PSU1=$PIECE($GET(^DGPT(PSUC,70)),U,10)
IF PSU1=""
SET PSU1="NULL"
+4 ;Ptr 2
SET PSU2=$PIECE($GET(^DGPT(PSUC,70)),U,16)
IF PSU2=""
SET PSU2="NULL"
+5 ;Ptr 3
SET PSU3=$PIECE($GET(^DGPT(PSUC,70)),U,17)
IF PSU3=""
SET PSU3="NULL"
+6 ;Ptr 4
SET PSU4=$PIECE($GET(^DGPT(PSUC,70)),U,18)
IF PSU4=""
SET PSU4="NULL"
+7 ;Ptr 5
SET PSU5=$PIECE($GET(^DGPT(PSUC,70)),U,19)
IF PSU5=""
SET PSU5="NULL"
+8 ;Ptr 6
SET PSU6=$PIECE($GET(^DGPT(PSUC,70)),U,20)
IF PSU6=""
SET PSU6="NULL"
+9 ;Ptr 7
SET PSU7=$PIECE($GET(^DGPT(PSUC,70)),U,21)
IF PSU7=""
SET PSU7="NULL"
+10 ;Ptr 8
SET PSU8=$PIECE($GET(^DGPT(PSUC,70)),U,22)
IF PSU8=""
SET PSU8="NULL"
+11 ;Ptr 9
SET PSU9=$PIECE($GET(^DGPT(PSUC,70)),U,23)
IF PSU9=""
SET PSU9="NULL"
+12 ;Ptr 10
SET PSU10=$PIECE($GET(^DGPT(PSUC,70)),U,24)
IF PSU10=""
SET PSU10="NULL"
+13 ;Ptr 11
SET PSU11=$PIECE($GET(^DGPT(PSUC,70)),U,11)
IF PSU11=""
SET PSU11="NULL"
+14 DO ICD91
+15 QUIT
+16 ;
ICD91 ;Find ICD9 codes from pointer on ^DGPT(D0,70 node and place in
+1 ;an array
+2 ;
+3 NEW PSUID1,PSUID2,PSUID3,PSUID4,PSUID5,PSUID6,PSUID7,PSUID8,PSUID9
+4 NEW PSUID10,PSUID11
+5 IF PSU1'["N"
SET PSUID1=$PIECE($GET(^ICD9(PSU1,0)),U)
Begin DoDot:1
+6 ;1ST ICD9 CODE
IF $DATA(PSUID1)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,1,PSUID1)=""
End DoDot:1
+7 IF PSU2'["N"
SET PSUID2=$PIECE($GET(^ICD9(PSU2,0)),U)
Begin DoDot:1
+8 ;2ND ICD9 CODE
IF $DATA(PSUID2)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,2,PSUID2)=""
End DoDot:1
+9 IF PSU3'["N"
SET PSUID3=$PIECE($GET(^ICD9(PSU3,0)),U)
Begin DoDot:1
+10 ;3rd ICD9 CODE
IF $DATA(PSUID3)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,3,PSUID3)=""
End DoDot:1
+11 IF PSU4'["N"
SET PSUID4=$PIECE($GET(^ICD9(PSU4,0)),U)
Begin DoDot:1
+12 ;4th ICD9 CODE
IF $DATA(PSUID4)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,4,PSUID4)=""
End DoDot:1
+13 IF PSU5'["N"
SET PSUID5=$PIECE($GET(^ICD9(PSU5,0)),U)
Begin DoDot:1
+14 ;5th ICD9 CODE
IF $DATA(PSUID5)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,5,PSUID5)=""
End DoDot:1
+15 IF PSU6'["N"
SET PSUID6=$PIECE($GET(^ICD9(PSU6,0)),U)
Begin DoDot:1
+16 ;6th ICD9 CODE
IF $DATA(PSUID6)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,6,PSUID6)=""
End DoDot:1
+17 IF PSU7'["N"
SET PSUID7=$PIECE($GET(^ICD9(PSU7,0)),U)
Begin DoDot:1
+18 ;7th ICD9 CODE
IF $DATA(PSUID7)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,7,PSUID7)=""
End DoDot:1
+19 IF PSU8'["N"
SET PSUID8=$PIECE($GET(^ICD9(PSU8,0)),U)
Begin DoDot:1
+20 ;8th ICD9 CODE
IF $DATA(PSUID8)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,8,PSUID8)=""
End DoDot:1
+21 IF PSU9'["N"
SET PSUID9=$PIECE($GET(^ICD9(PSU9,0)),U)
Begin DoDot:1
+22 ;9th ICD9 CODE
IF $DATA(PSUID9)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,9,PSUID9)=""
End DoDot:1
+23 IF PSU10'["N"
SET PSUID10=$PIECE($GET(^ICD9(PSU10,0)),U)
Begin DoDot:1
+24 ;10th ICD9 CODE
IF $DATA(PSUID10)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,10,PSUID10)=""
End DoDot:1
+25 IF PSU11'["N"
SET PSUID11=$PIECE($GET(^ICD9(PSU11,0)),U)
Begin DoDot:1
+26 ;11th ICD9 CODE
IF $DATA(PSUID11)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,11,PSUID11)=""
End DoDot:1
+27 QUIT
+28 ;
PTFM ;
+1 SET PSUCD=0
+2 SET I=12
+3 FOR
SET PSUCD=$ORDER(^DGPT(PSUC,"M","AC",PSUCD))
IF 'PSUCD
QUIT
Begin DoDot:1
+4 IF PSUCD=""
SET PSUCD="N"
+5 NEW PSUIDT
+6 SET PSUIDT=$PIECE($GET(^ICD9(PSUCD,0)),U)
Begin DoDot:2
+7 SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUIDT)=""
+8 DO DEL
+9 SET I=I+1
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
DEL ;Delete duplicates
+1 ;
+2 FOR N=1:1:10
IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,N,PSUIDT))
Begin DoDot:1
+3 KILL ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUIDT)
End DoDot:1
+4 QUIT
+5 ;
FIN ;$O through array, and set codes into the Inpatient Record
+1 ;global ^XTMP("PSU_"_PSUJOB,"PSUIPV"
+2 ;
+3 SET T=0
SET N=8
+4 FOR
SET T=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T))
IF 'T
QUIT
IF N=29
QUIT
Begin DoDot:1
+5 SET PSUIDF=0
+6 FOR
SET PSUIDF=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF))
IF 'PSUIDF
QUIT
Begin DoDot:2
+7 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)=PSUIDF
+8 SET N=N+1
End DoDot:2
End DoDot:1
+9 ;
+10 FOR N=8:1:28
IF '$PIECE(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)
Begin DoDot:1
+11 ;Set unfilled pieces to null
SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)=""
End DoDot:1
+12 QUIT
