- 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
