PSUDEM8 ;BIR/DAM - ICD9 Codes for Inpatient PTF Record Extract ;20 DEC 2001
;;4.0;PHARMACY BENEFITS MANAGEMENT;**19**;MARCH, 2005;Build 28
;
;DBIA's
; Reference to file 45 supported by DBIA 3511
; Reference to file 80 supported by DBIA 10082
; Reference to ICDEX supported by DBIA 5747
; Reference to ICDXCODE supported by DBIA 5699
;
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
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 ICD pointers present on ^DGPT(D0,70 node
;drp 2/13/2012 added second line to each line in old block
;N PSU1,PSU2,PSU3,PSU4,PSU5,PSU6,PSU7,PSU8,PSU9,PSU10,PSU11
N PSU1,PSU2,PSU3,PSU4,PSU5,PSU6,PSU7,PSU8,PSU9,PSU10,PSU11,CSYS
;
S PSU1=$P($G(^DGPT(PSUC,70)),U,10) S:PSU1="" PSU1="NULL" ;Ptr 1 PRINCIPAL[10P:80
S:PSU1'="NULL" CSYS(1)=$$CSI^ICDEX(80,PSU1),PSU1("ICDSYS")=$S(CSYS(1)=1:9,CSYS(1)=30:10,1:"")
;
S PSU2=$P($G(^DGPT(PSUC,70)),U,16) S:PSU2="" PSU2="NULL" ;Ptr 2 SECONDARY[16P:80]
S:PSU2'="NULL" CSYS(2)=$$CSI^ICDEX(80,PSU2),PSU2("ICDSYS")=$S(CSYS(2)=1:9,CSYS(2)=30:10,1:"")
;
S PSU3=$P($G(^DGPT(PSUC,70)),U,17) S:PSU3="" PSU3="NULL" ;Ptr 3
S:PSU3'="NULL" CSYS(3)=$$CSI^ICDEX(80,PSU3),PSU3("ICDSYS")=$S(CSYS(3)=1:9,CSYS(3)=30:10,1:"")
;
S PSU4=$P($G(^DGPT(PSUC,70)),U,18) S:PSU4="" PSU4="NULL" ;Ptr 4
S:PSU4'="NULL" CSYS(4)=$$CSI^ICDEX(80,PSU4),PSU4("ICDSYS")=$S(CSYS(4)=1:9,CSYS(4)=30:10,1:"")
;
S PSU5=$P($G(^DGPT(PSUC,70)),U,19) S:PSU5="" PSU5="NULL" ;Ptr 5
S:PSU5'="NULL" CSYS(5)=$$CSI^ICDEX(80,PSU5),PSU5("ICDSYS")=$S(CSYS(5)=1:9,CSYS(5)=30:10,1:"")
;
S PSU6=$P($G(^DGPT(PSUC,70)),U,20) S:PSU6="" PSU6="NULL" ;Ptr 6
S:PSU6'="NULL" CSYS(6)=$$CSI^ICDEX(80,PSU6),PSU6("ICDSYS")=$S(CSYS(6)=1:9,CSYS(6)=30:10,1:"")
;
S PSU7=$P($G(^DGPT(PSUC,70)),U,21) S:PSU7="" PSU7="NULL" ;Ptr 7
S:PSU7'="NULL" CSYS(7)=$$CSI^ICDEX(80,PSU7),PSU7("ICDSYS")=$S(CSYS(7)=1:9,CSYS(7)=30:10,1:"")
;
S PSU8=$P($G(^DGPT(PSUC,70)),U,22) S:PSU8="" PSU8="NULL" ;Ptr 8
S:PSU8'="NULL" CSYS(8)=$$CSI^ICDEX(80,PSU8),PSU8("ICDSYS")=$S(CSYS(8)=1:9,CSYS(8)=30:10,1:"")
;
S PSU9=$P($G(^DGPT(PSUC,70)),U,23) S:PSU9="" PSU9="NULL" ;Ptr 9
S:PSU9'="NULL" CSYS(9)=$$CSI^ICDEX(80,PSU9),PSU9("ICDSYS")=$S(CSYS(9)=1:9,CSYS(9)=30:10,1:"")
;
S PSU10=$P($G(^DGPT(PSUC,70)),U,24) S:PSU10="" PSU10="NULL" ;Ptr 10
S:PSU10'="NULL" CSYS(10)=$$CSI^ICDEX(80,PSU10),PSU10("ICDSYS")=$S(CSYS(10)=1:9,CSYS(10)=30:10,1:"")
;
S PSU11=$P($G(^DGPT(PSUC,70)),U,11) S:PSU11="" PSU11="NULL" ;Ptr 11 PRINCIPAL DIAGNOSIS pre 1986 [11P:80]
S:PSU11'="NULL" CSYS(11)=$$CSI^ICDEX(80,PSU11),PSU11("ICDSYS")=$S(CSYS(11)=1:9,CSYS(11)=30:10,1:"")
D ICD91
Q
;
ICD91 ;Find ICD 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($$ICDDATA^ICDXCODE(CSYS(1),PSU1),U,2) D
.I $D(PSUID1) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,1,PSUID1)=$G(PSU1("ICDSYS")) ;1ST ICD CODE
S:PSU2'["N" PSUID2=$P($$ICDDATA^ICDXCODE(CSYS(2),PSU2),U,2) D
.I $D(PSUID2) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,2,PSUID2)=$G(PSU2("ICDSYS")) ;2ND ICD CODE
S:PSU3'["N" PSUID3=$P($$ICDDATA^ICDXCODE(CSYS(3),PSU3),U,2) D
.I $D(PSUID3) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,3,PSUID3)=$G(PSU3("ICDSYS")) ;3rd ICD CODE
S:PSU4'["N" PSUID4=$P($$ICDDATA^ICDXCODE(CSYS(4),PSU4),U,2) D
.I $D(PSUID4) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,4,PSUID4)=$G(PSU4("ICDSYS")) ;4th ICD CODE
S:PSU5'["N" PSUID5=$P($$ICDDATA^ICDXCODE(CSYS(5),PSU5),U,2) D
.I $D(PSUID5) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,5,PSUID5)=$G(PSU5("ICDSYS")) ;5th ICD CODE
S:PSU6'["N" PSUID6=$P($$ICDDATA^ICDXCODE(CSYS(6),PSU6),U,2) D
.I $D(PSUID6) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,6,PSUID6)=$G(PSU6("ICDSYS")) ;6th ICD CODE
S:PSU7'["N" PSUID7=$P($$ICDDATA^ICDXCODE(CSYS(7),PSU7),U,2) D
.I $D(PSUID7) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,7,PSUID7)=$G(PSU7("ICDSYS")) ;7th ICD CODE
S:PSU8'["N" PSUID8=$P($$ICDDATA^ICDXCODE(CSYS(8),PSU8),U,2) D
.I $D(PSUID8) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,8,PSUID8)=$G(PSU8("ICDSYS")) ;8th ICD CODE
S:PSU9'["N" PSUID9=$P($$ICDDATA^ICDXCODE(CSYS(9),PSU9),U,2) D
.I $D(PSUID9) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,9,PSUID9)=$G(PSU9("ICDSYS")) ;9th ICD CODE
S:PSU10'["N" PSUID10=$P($$ICDDATA^ICDXCODE(CSYS(10),PSU10),U,2) D
.I $D(PSUID10) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,10,PSUID10)=$G(PSU10("ICDSYS")) ;10th ICD CODE
S:PSU11'["N" PSUID11=$P($$ICDDATA^ICDXCODE(CSYS(11),PSU11),U,2) D
.I $D(PSUID11) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,11,PSUID11)=$G(PSU11("ICDSYS")) ;11th ICD 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
.I PSUCD'="N" D
..S CSYS(I)=$$CSI^ICDEX(80,PSUCD),PSUIDT=$P(($$ICDDATA^ICDXCODE(CSYS(I),PSUCD)),U,2)
..S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUIDT)=$S(CSYS(I)=1:9,CSYS(I)=30:10,1:"")
..D DEL
..S I=I+1
.Q
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", ISYSCODE and SYSCODE are the coding system values
;DRP 2/13/2012 ADDED SYSCODE LOGIC
N SYSCODE,ISYSCODE
S T=0,N=8
F S T=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T)) Q:'T Q:N=29 D
.S PSUIDF=""
.F S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF)) Q:'(PSUIDF]"") D
..S SYSCODE=$G(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF)) S:$G(ISYSCODE)="" ISYSCODE=SYSCODE
..S:SYSCODE'="" SYSCODE=$S(SYSCODE=ISYSCODE:SYSCODE,1:"U") ; Set to "U" if there has been a change
..I SYSCODE="U",ISYSCODE'="U" S ISYSCODE="U" ;
..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
K PSUCSYS1 S PSUCSYS1=$G(SYSCODE,"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUDEM8 6396 printed Sep 23, 2025@20:03:29 Page 2
PSUDEM8 ;BIR/DAM - ICD9 Codes for Inpatient PTF Record Extract ;20 DEC 2001
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**19**;MARCH, 2005;Build 28
+2 ;
+3 ;DBIA's
+4 ; Reference to file 45 supported by DBIA 3511
+5 ; Reference to file 80 supported by DBIA 10082
+6 ; Reference to ICDEX supported by DBIA 5747
+7 ; Reference to ICDXCODE supported by DBIA 5699
+8 ;
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 ;S PSUC=0
+3 SET PSUC=0
+4 FOR
SET PSUC=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC))
if 'PSUC
QUIT
Begin DoDot:1
+5 ;gather ICD9 data on ^DGPT(D0,70 node
DO PTF70
+6 ;gather ICD9 data on ^DGPT(D0,"M","AC" node
DO PTFM
+7 DO FIN
KILL ^XTMP("PSU_"_PSUJOB,"PSUTMP3")
+8 ;gather CPT data on 2 separate ^DGPT nodes
DO EN^PSUDEM9
End DoDot:1
+9 QUIT
+10 ;
PTF70 ;Find all ICD pointers present on ^DGPT(D0,70 node
+1 ;drp 2/13/2012 added second line to each line in old block
+2 ;N PSU1,PSU2,PSU3,PSU4,PSU5,PSU6,PSU7,PSU8,PSU9,PSU10,PSU11
+3 NEW PSU1,PSU2,PSU3,PSU4,PSU5,PSU6,PSU7,PSU8,PSU9,PSU10,PSU11,CSYS
+4 ;
+5 ;Ptr 1 PRINCIPAL[10P:80
SET PSU1=$PIECE($GET(^DGPT(PSUC,70)),U,10)
if PSU1=""
SET PSU1="NULL"
+6 if PSU1'="NULL"
SET CSYS(1)=$$CSI^ICDEX(80,PSU1)
SET PSU1("ICDSYS")=$SELECT(CSYS(1)=1:9,CSYS(1)=30:10,1:"")
+7 ;
+8 ;Ptr 2 SECONDARY[16P:80]
SET PSU2=$PIECE($GET(^DGPT(PSUC,70)),U,16)
if PSU2=""
SET PSU2="NULL"
+9 if PSU2'="NULL"
SET CSYS(2)=$$CSI^ICDEX(80,PSU2)
SET PSU2("ICDSYS")=$SELECT(CSYS(2)=1:9,CSYS(2)=30:10,1:"")
+10 ;
+11 ;Ptr 3
SET PSU3=$PIECE($GET(^DGPT(PSUC,70)),U,17)
if PSU3=""
SET PSU3="NULL"
+12 if PSU3'="NULL"
SET CSYS(3)=$$CSI^ICDEX(80,PSU3)
SET PSU3("ICDSYS")=$SELECT(CSYS(3)=1:9,CSYS(3)=30:10,1:"")
+13 ;
+14 ;Ptr 4
SET PSU4=$PIECE($GET(^DGPT(PSUC,70)),U,18)
if PSU4=""
SET PSU4="NULL"
+15 if PSU4'="NULL"
SET CSYS(4)=$$CSI^ICDEX(80,PSU4)
SET PSU4("ICDSYS")=$SELECT(CSYS(4)=1:9,CSYS(4)=30:10,1:"")
+16 ;
+17 ;Ptr 5
SET PSU5=$PIECE($GET(^DGPT(PSUC,70)),U,19)
if PSU5=""
SET PSU5="NULL"
+18 if PSU5'="NULL"
SET CSYS(5)=$$CSI^ICDEX(80,PSU5)
SET PSU5("ICDSYS")=$SELECT(CSYS(5)=1:9,CSYS(5)=30:10,1:"")
+19 ;
+20 ;Ptr 6
SET PSU6=$PIECE($GET(^DGPT(PSUC,70)),U,20)
if PSU6=""
SET PSU6="NULL"
+21 if PSU6'="NULL"
SET CSYS(6)=$$CSI^ICDEX(80,PSU6)
SET PSU6("ICDSYS")=$SELECT(CSYS(6)=1:9,CSYS(6)=30:10,1:"")
+22 ;
+23 ;Ptr 7
SET PSU7=$PIECE($GET(^DGPT(PSUC,70)),U,21)
if PSU7=""
SET PSU7="NULL"
+24 if PSU7'="NULL"
SET CSYS(7)=$$CSI^ICDEX(80,PSU7)
SET PSU7("ICDSYS")=$SELECT(CSYS(7)=1:9,CSYS(7)=30:10,1:"")
+25 ;
+26 ;Ptr 8
SET PSU8=$PIECE($GET(^DGPT(PSUC,70)),U,22)
if PSU8=""
SET PSU8="NULL"
+27 if PSU8'="NULL"
SET CSYS(8)=$$CSI^ICDEX(80,PSU8)
SET PSU8("ICDSYS")=$SELECT(CSYS(8)=1:9,CSYS(8)=30:10,1:"")
+28 ;
+29 ;Ptr 9
SET PSU9=$PIECE($GET(^DGPT(PSUC,70)),U,23)
if PSU9=""
SET PSU9="NULL"
+30 if PSU9'="NULL"
SET CSYS(9)=$$CSI^ICDEX(80,PSU9)
SET PSU9("ICDSYS")=$SELECT(CSYS(9)=1:9,CSYS(9)=30:10,1:"")
+31 ;
+32 ;Ptr 10
SET PSU10=$PIECE($GET(^DGPT(PSUC,70)),U,24)
if PSU10=""
SET PSU10="NULL"
+33 if PSU10'="NULL"
SET CSYS(10)=$$CSI^ICDEX(80,PSU10)
SET PSU10("ICDSYS")=$SELECT(CSYS(10)=1:9,CSYS(10)=30:10,1:"")
+34 ;
+35 ;Ptr 11 PRINCIPAL DIAGNOSIS pre 1986 [11P:80]
SET PSU11=$PIECE($GET(^DGPT(PSUC,70)),U,11)
if PSU11=""
SET PSU11="NULL"
+36 if PSU11'="NULL"
SET CSYS(11)=$$CSI^ICDEX(80,PSU11)
SET PSU11("ICDSYS")=$SELECT(CSYS(11)=1:9,CSYS(11)=30:10,1:"")
+37 DO ICD91
+38 QUIT
+39 ;
ICD91 ;Find ICD 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($$ICDDATA^ICDXCODE(CSYS(1),PSU1),U,2)
Begin DoDot:1
+6 ;1ST ICD CODE
IF $DATA(PSUID1)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,1,PSUID1)=$GET(PSU1("ICDSYS"))
End DoDot:1
+7 if PSU2'["N"
SET PSUID2=$PIECE($$ICDDATA^ICDXCODE(CSYS(2),PSU2),U,2)
Begin DoDot:1
+8 ;2ND ICD CODE
IF $DATA(PSUID2)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,2,PSUID2)=$GET(PSU2("ICDSYS"))
End DoDot:1
+9 if PSU3'["N"
SET PSUID3=$PIECE($$ICDDATA^ICDXCODE(CSYS(3),PSU3),U,2)
Begin DoDot:1
+10 ;3rd ICD CODE
IF $DATA(PSUID3)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,3,PSUID3)=$GET(PSU3("ICDSYS"))
End DoDot:1
+11 if PSU4'["N"
SET PSUID4=$PIECE($$ICDDATA^ICDXCODE(CSYS(4),PSU4),U,2)
Begin DoDot:1
+12 ;4th ICD CODE
IF $DATA(PSUID4)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,4,PSUID4)=$GET(PSU4("ICDSYS"))
End DoDot:1
+13 if PSU5'["N"
SET PSUID5=$PIECE($$ICDDATA^ICDXCODE(CSYS(5),PSU5),U,2)
Begin DoDot:1
+14 ;5th ICD CODE
IF $DATA(PSUID5)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,5,PSUID5)=$GET(PSU5("ICDSYS"))
End DoDot:1
+15 if PSU6'["N"
SET PSUID6=$PIECE($$ICDDATA^ICDXCODE(CSYS(6),PSU6),U,2)
Begin DoDot:1
+16 ;6th ICD CODE
IF $DATA(PSUID6)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,6,PSUID6)=$GET(PSU6("ICDSYS"))
End DoDot:1
+17 if PSU7'["N"
SET PSUID7=$PIECE($$ICDDATA^ICDXCODE(CSYS(7),PSU7),U,2)
Begin DoDot:1
+18 ;7th ICD CODE
IF $DATA(PSUID7)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,7,PSUID7)=$GET(PSU7("ICDSYS"))
End DoDot:1
+19 if PSU8'["N"
SET PSUID8=$PIECE($$ICDDATA^ICDXCODE(CSYS(8),PSU8),U,2)
Begin DoDot:1
+20 ;8th ICD CODE
IF $DATA(PSUID8)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,8,PSUID8)=$GET(PSU8("ICDSYS"))
End DoDot:1
+21 if PSU9'["N"
SET PSUID9=$PIECE($$ICDDATA^ICDXCODE(CSYS(9),PSU9),U,2)
Begin DoDot:1
+22 ;9th ICD CODE
IF $DATA(PSUID9)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,9,PSUID9)=$GET(PSU9("ICDSYS"))
End DoDot:1
+23 if PSU10'["N"
SET PSUID10=$PIECE($$ICDDATA^ICDXCODE(CSYS(10),PSU10),U,2)
Begin DoDot:1
+24 ;10th ICD CODE
IF $DATA(PSUID10)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,10,PSUID10)=$GET(PSU10("ICDSYS"))
End DoDot:1
+25 if PSU11'["N"
SET PSUID11=$PIECE($$ICDDATA^ICDXCODE(CSYS(11),PSU11),U,2)
Begin DoDot:1
+26 ;11th ICD CODE
IF $DATA(PSUID11)
SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,11,PSUID11)=$GET(PSU11("ICDSYS"))
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 IF PSUCD'="N"
Begin DoDot:2
+7 SET CSYS(I)=$$CSI^ICDEX(80,PSUCD)
SET PSUIDT=$PIECE(($$ICDDATA^ICDXCODE(CSYS(I),PSUCD)),U,2)
+8 SET ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUIDT)=$SELECT(CSYS(I)=1:9,CSYS(I)=30:10,1:"")
+9 DO DEL
+10 SET I=I+1
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
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", ISYSCODE and SYSCODE are the coding system values
+2 ;DRP 2/13/2012 ADDED SYSCODE LOGIC
+3 NEW SYSCODE,ISYSCODE
+4 SET T=0
SET N=8
+5 FOR
SET T=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T))
if 'T
QUIT
if N=29
QUIT
Begin DoDot:1
+6 SET PSUIDF=""
+7 FOR
SET PSUIDF=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF))
if '(PSUIDF]"")
QUIT
Begin DoDot:2
+8 SET SYSCODE=$GET(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF))
if $GET(ISYSCODE)=""
SET ISYSCODE=SYSCODE
+9 ; Set to "U" if there has been a change
if SYSCODE'=""
SET SYSCODE=$SELECT(SYSCODE=ISYSCODE:SYSCODE,1:"U")
+10 ;
IF SYSCODE="U"
IF ISYSCODE'="U"
SET ISYSCODE="U"
+11 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)=PSUIDF
+12 SET N=N+1
End DoDot:2
End DoDot:1
+13 FOR N=8:1:28
IF '($PIECE(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)]"")
Begin DoDot:1
+14 ;Set unfilled pieces to null
SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)=""
+15 QUIT
End DoDot:1
+16 KILL PSUCSYS1
SET PSUCSYS1=$GET(SYSCODE,"")
+17 QUIT
