RMPR9LNP ;Hines OIFO/HNC - REMOTE PROCEDURE, LIST NPPD DATA ;9/8/03 07:23
;;3.0;PROSTHETICS;**71,77,90,75,60,143,150,168**;Feb 09, 1996;Build 43
;
; Reference to $$SINFO^ICDEX supported by ICR #5747
; Reference to $$ICDDX^ICDEX supported by ICR #5747
; Reference to $$CSI^ICDEX supported by ICR #5747
;
; HNC - Sept 2, 2003 - patch 77 remove the " for Excel CSV
; HNC - Feb 14, 2005 - patch 90 add flex field to GUI display
; HNC - Nov 15, 2005 - patch 75 add 2 additional flex field to gui
; RRA - March 20, 2008 - patch 143 added " back for excel CSV
;
;RESULTS passed to broker in ^TMP($J,
;delimited by "^"
;piece 1 = ENTRY DATE
;piece 2 = PATIENT NAME IF OEF/OIF <!> PRECEDES THE NAME
;piece 3 = PSAS HCPCS with * if hcpcs has Calculation Flag
;piece 4 = QTY
;piece 5 = VENDOR
;piece 6 = INITIAL ACTION DATE
;piece 7 = TOTAL COST
;piece 8 = DESCRIPTION
;piece 9 = INITIATOR
;piece 10 = NPPD LINE BEFORE GROUPER
;piece 11 = STATION
;piece 12 = GROUPER NUMBER
;piece 13 = FORM REQUESTED ON
;piece 14 = TYPE OF TRANSACTION
;piece 15 = SSN
;piece 16 = IEN TO FILE 660
;piece 17 = HCPCS SHORT DESCRIPTION
;piece 18 = SOURCE
;piece 19 = Optional Flex Field
;piece 20 = Optional Flex Field
;piece 21 = Optional Flex Field
Q
;
EN(RESULT,DATE1,DATE2,FLEXF,FLEX2,FLEX3) ;broker entry point
;
K ^TMP($J)
I '$D(DATE1)!('$D(DATE2)) G EXIT
S DATE=DATE1-1
F S DATE=$O(^RMPR(660,"B",DATE)) Q:(DATE="")!($P(DATE,".",1)>DATE2) D
.S RMPRB=0
.F S RMPRB=$O(^RMPR(660,"B",DATE,RMPRB)) Q:RMPRB="" D
..I $P(^RMPR(660,RMPRB,0),U,15)["*" Q:$P($G(^RMPR(660,RMPRB,"HSTV1")),U,3)=""
..S PHCPCS=$P($G(^RMPR(660,RMPRB,1)),U,4)
..Q:PHCPCS=""
..Q:PHCPCS'>0
..S HDES=$P(^RMPR(661.1,PHCPCS,0),U,2)
..S TYPE=$P($G(^RMPR(660,RMPRB,0)),U,4)
..I "X5"'[TYPE S LINE=$P(^RMPR(661.1,PHCPCS,0),U,7)
..I "X5"[TYPE S LINE=$P(^RMPR(661.1,PHCPCS,0),U,6)
..S CAL=$P(^RMPR(661.1,PHCPCS,0),U,8)
..I CAL'="" S CAL="*"
..S DFN=$P(^RMPR(660,RMPRB,0),U,2)
..D DEM^VADPT,SVC^VADPT
..S RMPROEOI=$S(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
..D DATA
S RESULT=$NA(^TMP($J))
K DATE,DFN,HDES,LINE,PHCPCS,RMPRB,RMPRFLD,TYPE,B
Q
;
DATA ;
;
; ICD10 Changes - Determine Active Coding System
N RMPRCSI
S RMPRCSI=$$SINFO^ICDEX("DIAG",DATE) ; Coding System Info
;
S B=RMPRB
S RMPRFLD=".01;.02;4.5;5;7;8;8.3;11;12;14;24;27;68"
;
; Process user selected fields
I FLEXF'="" S RMPRFLD=RMPRFLD_";"_FLEXF
I FLEX2'="" S RMPRFLD=RMPRFLD_";"_FLEX2
I FLEX3'="" S RMPRFLD=RMPRFLD_";"_FLEX3
;
I FLEXF=8.7!(FLEX2=8.7)!(FLEX3=8.7) D
.I (";"_RMPRFLD_";")'[(";"_8.8_";") S RMPRFLD=RMPRFLD_";"_8.8
;
D GETS^DIQ(660,B,RMPRFLD,"","RMXM")
S RMPRPTNM=$G(RMXM(660,B_",",.02))
I RMPROEOI["<" S RMPRPTNM=RMPROEOI_RMPRPTNM
S $P(^TMP($J,B),U,1)=$G(RMXM(660,B_",",.01))
S $P(^TMP($J,B),U,2)=RMPRPTNM
S $P(^TMP($J,B),U,3)=$G(RMXM(660,B_",",4.5))_CAL
S $P(^TMP($J,B),U,4)=$G(RMXM(660,B_",",5))
S $P(^TMP($J,B),U,5)=$G(RMXM(660,B_",",7))
S $P(^TMP($J,B),U,6)=$G(RMXM(660,B_",",8.3))
S $P(^TMP($J,B),U,7)=$G(RMXM(660,B_",",14))
S $P(^TMP($J,B),U,8)=$G(RMXM(660,B_",",24))
S $P(^TMP($J,B),U,9)=$G(RMXM(660,B_",",27))
S $P(^TMP($J,B),U,10)=LINE
S $P(^TMP($J,B),U,11)=$G(RMXM(660,B_",",8))
S $P(^TMP($J,B),U,12)=$G(RMXM(660,B_",",68))
S $P(^TMP($J,B),U,13)=$G(RMXM(660,B_",",11))
S $P(^TMP($J,B),U,14)=TYPE
S $P(^TMP($J,B),U,15)=$P(VADM(2),U,2)
S $P(^TMP($J,B),U,16)=B
S $P(^TMP($J,B),U,17)=HDES
S $P(^TMP($J,B),U,18)=$E($G(RMXM(660,B_",",12)),0,1)
;
; Process user selected fields
I FLEXF'="" D
.; Check if PROVISIONAL DIAGNOSIS (#8.7) was selected
.I FLEXF=8.7 D Q
..; If ICD-9 era get #8.7 from #660
..I +RMPRCSI=1,($G(RMXM(660,B_",",FLEXF))'="") S $P(^TMP($J,B),U,19)=$G(RMXM(660,B_",",FLEXF)) Q
..; If ICD-10 era get "short description" (i.e. DIAGNOSIS) from #80
..I +RMPRCSI=30,($G(RMXM(660,B_",",FLEXF))'="") D Q
...S $P(^TMP($J,B),U,19)=$$ICDSD(RMXM(660,B_",",8.8),DATE,+RMPRCSI)
..; If Provisional Diagnosis was blank
..S $P(^TMP($J,B),U,19)=""
.; Check if SUSPENSE ICD (#8.8) was selected
.I FLEXF=8.8 D Q
..I $G(RMXM(660,B_",",FLEXF))'="" D ICDCS(FLEXF,19,RMPRB_",") Q
..S $P(^TMP($J,B),U,19)=""
.; User specified a field other than 8.7 or 8.8
.I FLEXF'="" S $P(^TMP($J,B),U,19)=$G(RMXM(660,B_",",FLEXF))
; User didn't specify a field for 1st choice
I FLEXF="" S $P(^TMP($J,B),U,19)=""
;
; Process 2nd user selected field
I FLEX2'="" D
.; Check if PROVISIONAL DIAGNOSIS (#8.7) was selected
.I FLEX2=8.7 D Q
..; If ICD-9 era get #8.7 from #660
..I +RMPRCSI=1,($G(RMXM(660,B_",",FLEX2))'="") S $P(^TMP($J,B),U,20)=$G(RMXM(660,B_",",FLEX2)) Q
..; If ICD-10 era get "short description" (i.e. DIAGNOSIS) from #80
..I +RMPRCSI=30,($G(RMXM(660,B_",",FLEX2))'="") D Q
...S $P(^TMP($J,B),U,20)=$$ICDSD(RMXM(660,B_",",8.8),DATE,+RMPRCSI)
..; If Provisional Diagnosis was blank
..S $P(^TMP($J,B),U,20)=""
.; Check if SUSPENSE ICD (#8.8) was selected
.I FLEX2=8.8 D Q
..I $G(RMXM(660,B_",",FLEX2))'="" D ICDCS(FLEX2,20,RMPRB_",") Q
..S $P(^TMP($J,B),U,20)=""
.; User specified a field other than 8.7 or 8.8
.I FLEX2'="" S $P(^TMP($J,B),U,20)=$G(RMXM(660,B_",",FLEX2))
; User didn't specify a field for 2nd choice
I FLEX2="" S $P(^TMP($J,B),U,20)=""
;
; Process 3rd user selected field
I FLEX3'="" D
.; Check if PROVISIONAL DIAGNOSIS (#8.7) was selected
.I FLEX3=8.7 D Q
..; If ICD-9 era get #8.7 from #660
..I +RMPRCSI=1,($G(RMXM(660,B_",",FLEX3))'="") S $P(^TMP($J,B),U,21)=$G(RMXM(660,B_",",FLEX3)) Q
..; If ICD-10 era get "short description" (i.e. DIAGNOSIS) from #80
..I +RMPRCSI=30,($G(RMXM(660,B_",",FLEX3))'="") D Q
...S $P(^TMP($J,B),U,21)=$$ICDSD(RMXM(660,B_",",8.8),DATE,+RMPRCSI)
..; If Provisional Diagnosis was blank
..S $P(^TMP($J,B),U,21)=""
.; Check if SUSPENSE ICD (#8.8) was selected
.I FLEX3=8.8 D Q
..I $G(RMXM(660,B_",",FLEX3))'="" D ICDCS(FLEX3,21,RMPRB_",") Q
..S $P(^TMP($J,B),U,21)=""
.; User specified a field other than 8.7 or 8.8
.I FLEX3'="" S $P(^TMP($J,B),U,21)=$G(RMXM(660,B_",",FLEX3))
; User didn't specify a field for 2nd choice
I FLEX3="" S $P(^TMP($J,B),U,21)=""
;
K RMXM,VADM,CAL
Q
;
; Return Short Description (i.e. DIAGNOSIS) from #80
ICDSD(RMPRICD,DATE,RMPRCSI) ; Retrieve ICD Short Description from DIAGNOSIS field in #80
Q:RMPRICD="" ""
Q:DATE="" ""
Q:RMPRCSI="" ""
S RMPRICD=$$ICDDX^ICDEX(RMPRICD,DATE,RMPRCSI,"E") ; Supported by ICR 5747
; If API failed, return error message
I +RMPRICD<0 D Q RMPRICD
.S RMPRICD=$P(RMPRICD,U,2)
; Return Short Description
S RMPRICD=$P(RMPRICD,U,4)
Q RMPRICD
;
; Determine code set for ICD code and update appropriate return array piece
ICDCS(RMPRFNUM,RMPRANUM,RMPRIENS) ;
; RMPRFNUM = User Specified Field Number
; RMPRANUM = Array number to update
; RMPRIENS = #660 IEN
N RMPRACS
S RMPRACS=""
; Get ICD IEN from #660
S RMPRACS=$$GET1^DIQ(660,RMPRIENS,8.8,"I",,)
; Determine Code Set for ICD code
S RMPRACS=$$CSI^ICDEX(80,RMPRACS)
; Retrieve Info for Code Set
S RMPRACS=$$SINFO^ICDEX(RMPRACS)
; Convert Code Set to external numerical value. ICD-9 = 9, ICD-10 = 10 etc.
S RMPRACS=$P($P(RMPRACS,U,2),"-",2)
; Update appropriate piece of return array
S $P(^TMP($J,B),U,RMPRANUM)=$G(RMXM(660,B_",",RMPRFNUM))_"~"_RMPRACS
Q
;
EXIT ;common exit point
Q
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR9LNP 7477 printed Apr 09, 2024@21:38:17 Page 2
RMPR9LNP ;Hines OIFO/HNC - REMOTE PROCEDURE, LIST NPPD DATA ;9/8/03 07:23
+1 ;;3.0;PROSTHETICS;**71,77,90,75,60,143,150,168**;Feb 09, 1996;Build 43
+2 ;
+3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
+4 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
+5 ; Reference to $$CSI^ICDEX supported by ICR #5747
+6 ;
+7 ; HNC - Sept 2, 2003 - patch 77 remove the " for Excel CSV
+8 ; HNC - Feb 14, 2005 - patch 90 add flex field to GUI display
+9 ; HNC - Nov 15, 2005 - patch 75 add 2 additional flex field to gui
+10 ; RRA - March 20, 2008 - patch 143 added " back for excel CSV
+11 ;
+12 ;RESULTS passed to broker in ^TMP($J,
+13 ;delimited by "^"
+14 ;piece 1 = ENTRY DATE
+15 ;piece 2 = PATIENT NAME IF OEF/OIF <!> PRECEDES THE NAME
+16 ;piece 3 = PSAS HCPCS with * if hcpcs has Calculation Flag
+17 ;piece 4 = QTY
+18 ;piece 5 = VENDOR
+19 ;piece 6 = INITIAL ACTION DATE
+20 ;piece 7 = TOTAL COST
+21 ;piece 8 = DESCRIPTION
+22 ;piece 9 = INITIATOR
+23 ;piece 10 = NPPD LINE BEFORE GROUPER
+24 ;piece 11 = STATION
+25 ;piece 12 = GROUPER NUMBER
+26 ;piece 13 = FORM REQUESTED ON
+27 ;piece 14 = TYPE OF TRANSACTION
+28 ;piece 15 = SSN
+29 ;piece 16 = IEN TO FILE 660
+30 ;piece 17 = HCPCS SHORT DESCRIPTION
+31 ;piece 18 = SOURCE
+32 ;piece 19 = Optional Flex Field
+33 ;piece 20 = Optional Flex Field
+34 ;piece 21 = Optional Flex Field
+35 QUIT
+36 ;
EN(RESULT,DATE1,DATE2,FLEXF,FLEX2,FLEX3) ;broker entry point
+1 ;
+2 KILL ^TMP($JOB)
+3 IF '$DATA(DATE1)!('$DATA(DATE2))
GOTO EXIT
+4 SET DATE=DATE1-1
+5 FOR
SET DATE=$ORDER(^RMPR(660,"B",DATE))
if (DATE="")!($PIECE(DATE,".",1)>DATE2)
QUIT
Begin DoDot:1
+6 SET RMPRB=0
+7 FOR
SET RMPRB=$ORDER(^RMPR(660,"B",DATE,RMPRB))
if RMPRB=""
QUIT
Begin DoDot:2
+8 IF $PIECE(^RMPR(660,RMPRB,0),U,15)["*"
if $PIECE($GET(^RMPR(660,RMPRB,"HSTV1")),U,3)=""
QUIT
+9 SET PHCPCS=$PIECE($GET(^RMPR(660,RMPRB,1)),U,4)
+10 if PHCPCS=""
QUIT
+11 if PHCPCS'>0
QUIT
+12 SET HDES=$PIECE(^RMPR(661.1,PHCPCS,0),U,2)
+13 SET TYPE=$PIECE($GET(^RMPR(660,RMPRB,0)),U,4)
+14 IF "X5"'[TYPE
SET LINE=$PIECE(^RMPR(661.1,PHCPCS,0),U,7)
+15 IF "X5"[TYPE
SET LINE=$PIECE(^RMPR(661.1,PHCPCS,0),U,6)
+16 SET CAL=$PIECE(^RMPR(661.1,PHCPCS,0),U,8)
+17 IF CAL'=""
SET CAL="*"
+18 SET DFN=$PIECE(^RMPR(660,RMPRB,0),U,2)
+19 DO DEM^VADPT
DO SVC^VADPT
+20 SET RMPROEOI=$SELECT(VASV(11)>0:"<!>",VASV(12)>0:"<!>",VASV(13)>0:"<!>",1:0)
+21 DO DATA
End DoDot:2
End DoDot:1
+22 SET RESULT=$NAME(^TMP($JOB))
+23 KILL DATE,DFN,HDES,LINE,PHCPCS,RMPRB,RMPRFLD,TYPE,B
+24 QUIT
+25 ;
DATA ;
+1 ;
+2 ; ICD10 Changes - Determine Active Coding System
+3 NEW RMPRCSI
+4 ; Coding System Info
SET RMPRCSI=$$SINFO^ICDEX("DIAG",DATE)
+5 ;
+6 SET B=RMPRB
+7 SET RMPRFLD=".01;.02;4.5;5;7;8;8.3;11;12;14;24;27;68"
+8 ;
+9 ; Process user selected fields
+10 IF FLEXF'=""
SET RMPRFLD=RMPRFLD_";"_FLEXF
+11 IF FLEX2'=""
SET RMPRFLD=RMPRFLD_";"_FLEX2
+12 IF FLEX3'=""
SET RMPRFLD=RMPRFLD_";"_FLEX3
+13 ;
+14 IF FLEXF=8.7!(FLEX2=8.7)!(FLEX3=8.7)
Begin DoDot:1
+15 IF (";"_RMPRFLD_";")'[(";"_8.8_";")
SET RMPRFLD=RMPRFLD_";"_8.8
End DoDot:1
+16 ;
+17 DO GETS^DIQ(660,B,RMPRFLD,"","RMXM")
+18 SET RMPRPTNM=$GET(RMXM(660,B_",",.02))
+19 IF RMPROEOI["<"
SET RMPRPTNM=RMPROEOI_RMPRPTNM
+20 SET $PIECE(^TMP($JOB,B),U,1)=$GET(RMXM(660,B_",",.01))
+21 SET $PIECE(^TMP($JOB,B),U,2)=RMPRPTNM
+22 SET $PIECE(^TMP($JOB,B),U,3)=$GET(RMXM(660,B_",",4.5))_CAL
+23 SET $PIECE(^TMP($JOB,B),U,4)=$GET(RMXM(660,B_",",5))
+24 SET $PIECE(^TMP($JOB,B),U,5)=$GET(RMXM(660,B_",",7))
+25 SET $PIECE(^TMP($JOB,B),U,6)=$GET(RMXM(660,B_",",8.3))
+26 SET $PIECE(^TMP($JOB,B),U,7)=$GET(RMXM(660,B_",",14))
+27 SET $PIECE(^TMP($JOB,B),U,8)=$GET(RMXM(660,B_",",24))
+28 SET $PIECE(^TMP($JOB,B),U,9)=$GET(RMXM(660,B_",",27))
+29 SET $PIECE(^TMP($JOB,B),U,10)=LINE
+30 SET $PIECE(^TMP($JOB,B),U,11)=$GET(RMXM(660,B_",",8))
+31 SET $PIECE(^TMP($JOB,B),U,12)=$GET(RMXM(660,B_",",68))
+32 SET $PIECE(^TMP($JOB,B),U,13)=$GET(RMXM(660,B_",",11))
+33 SET $PIECE(^TMP($JOB,B),U,14)=TYPE
+34 SET $PIECE(^TMP($JOB,B),U,15)=$PIECE(VADM(2),U,2)
+35 SET $PIECE(^TMP($JOB,B),U,16)=B
+36 SET $PIECE(^TMP($JOB,B),U,17)=HDES
+37 SET $PIECE(^TMP($JOB,B),U,18)=$EXTRACT($GET(RMXM(660,B_",",12)),0,1)
+38 ;
+39 ; Process user selected fields
+40 IF FLEXF'=""
Begin DoDot:1
+41 ; Check if PROVISIONAL DIAGNOSIS (#8.7) was selected
+42 IF FLEXF=8.7
Begin DoDot:2
+43 ; If ICD-9 era get #8.7 from #660
+44 IF +RMPRCSI=1
IF ($GET(RMXM(660,B_",",FLEXF))'="")
SET $PIECE(^TMP($JOB,B),U,19)=$GET(RMXM(660,B_",",FLEXF))
QUIT
+45 ; If ICD-10 era get "short description" (i.e. DIAGNOSIS) from #80
+46 IF +RMPRCSI=30
IF ($GET(RMXM(660,B_",",FLEXF))'="")
Begin DoDot:3
+47 SET $PIECE(^TMP($JOB,B),U,19)=$$ICDSD(RMXM(660,B_",",8.8),DATE,+RMPRCSI)
End DoDot:3
QUIT
+48 ; If Provisional Diagnosis was blank
+49 SET $PIECE(^TMP($JOB,B),U,19)=""
End DoDot:2
QUIT
+50 ; Check if SUSPENSE ICD (#8.8) was selected
+51 IF FLEXF=8.8
Begin DoDot:2
+52 IF $GET(RMXM(660,B_",",FLEXF))'=""
DO ICDCS(FLEXF,19,RMPRB_",")
QUIT
+53 SET $PIECE(^TMP($JOB,B),U,19)=""
End DoDot:2
QUIT
+54 ; User specified a field other than 8.7 or 8.8
+55 IF FLEXF'=""
SET $PIECE(^TMP($JOB,B),U,19)=$GET(RMXM(660,B_",",FLEXF))
End DoDot:1
+56 ; User didn't specify a field for 1st choice
+57 IF FLEXF=""
SET $PIECE(^TMP($JOB,B),U,19)=""
+58 ;
+59 ; Process 2nd user selected field
+60 IF FLEX2'=""
Begin DoDot:1
+61 ; Check if PROVISIONAL DIAGNOSIS (#8.7) was selected
+62 IF FLEX2=8.7
Begin DoDot:2
+63 ; If ICD-9 era get #8.7 from #660
+64 IF +RMPRCSI=1
IF ($GET(RMXM(660,B_",",FLEX2))'="")
SET $PIECE(^TMP($JOB,B),U,20)=$GET(RMXM(660,B_",",FLEX2))
QUIT
+65 ; If ICD-10 era get "short description" (i.e. DIAGNOSIS) from #80
+66 IF +RMPRCSI=30
IF ($GET(RMXM(660,B_",",FLEX2))'="")
Begin DoDot:3
+67 SET $PIECE(^TMP($JOB,B),U,20)=$$ICDSD(RMXM(660,B_",",8.8),DATE,+RMPRCSI)
End DoDot:3
QUIT
+68 ; If Provisional Diagnosis was blank
+69 SET $PIECE(^TMP($JOB,B),U,20)=""
End DoDot:2
QUIT
+70 ; Check if SUSPENSE ICD (#8.8) was selected
+71 IF FLEX2=8.8
Begin DoDot:2
+72 IF $GET(RMXM(660,B_",",FLEX2))'=""
DO ICDCS(FLEX2,20,RMPRB_",")
QUIT
+73 SET $PIECE(^TMP($JOB,B),U,20)=""
End DoDot:2
QUIT
+74 ; User specified a field other than 8.7 or 8.8
+75 IF FLEX2'=""
SET $PIECE(^TMP($JOB,B),U,20)=$GET(RMXM(660,B_",",FLEX2))
End DoDot:1
+76 ; User didn't specify a field for 2nd choice
+77 IF FLEX2=""
SET $PIECE(^TMP($JOB,B),U,20)=""
+78 ;
+79 ; Process 3rd user selected field
+80 IF FLEX3'=""
Begin DoDot:1
+81 ; Check if PROVISIONAL DIAGNOSIS (#8.7) was selected
+82 IF FLEX3=8.7
Begin DoDot:2
+83 ; If ICD-9 era get #8.7 from #660
+84 IF +RMPRCSI=1
IF ($GET(RMXM(660,B_",",FLEX3))'="")
SET $PIECE(^TMP($JOB,B),U,21)=$GET(RMXM(660,B_",",FLEX3))
QUIT
+85 ; If ICD-10 era get "short description" (i.e. DIAGNOSIS) from #80
+86 IF +RMPRCSI=30
IF ($GET(RMXM(660,B_",",FLEX3))'="")
Begin DoDot:3
+87 SET $PIECE(^TMP($JOB,B),U,21)=$$ICDSD(RMXM(660,B_",",8.8),DATE,+RMPRCSI)
End DoDot:3
QUIT
+88 ; If Provisional Diagnosis was blank
+89 SET $PIECE(^TMP($JOB,B),U,21)=""
End DoDot:2
QUIT
+90 ; Check if SUSPENSE ICD (#8.8) was selected
+91 IF FLEX3=8.8
Begin DoDot:2
+92 IF $GET(RMXM(660,B_",",FLEX3))'=""
DO ICDCS(FLEX3,21,RMPRB_",")
QUIT
+93 SET $PIECE(^TMP($JOB,B),U,21)=""
End DoDot:2
QUIT
+94 ; User specified a field other than 8.7 or 8.8
+95 IF FLEX3'=""
SET $PIECE(^TMP($JOB,B),U,21)=$GET(RMXM(660,B_",",FLEX3))
End DoDot:1
+96 ; User didn't specify a field for 2nd choice
+97 IF FLEX3=""
SET $PIECE(^TMP($JOB,B),U,21)=""
+98 ;
+99 KILL RMXM,VADM,CAL
+100 QUIT
+101 ;
+102 ; Return Short Description (i.e. DIAGNOSIS) from #80
ICDSD(RMPRICD,DATE,RMPRCSI) ; Retrieve ICD Short Description from DIAGNOSIS field in #80
+1 if RMPRICD=""
QUIT ""
+2 if DATE=""
QUIT ""
+3 if RMPRCSI=""
QUIT ""
+4 ; Supported by ICR 5747
SET RMPRICD=$$ICDDX^ICDEX(RMPRICD,DATE,RMPRCSI,"E")
+5 ; If API failed, return error message
+6 IF +RMPRICD<0
Begin DoDot:1
+7 SET RMPRICD=$PIECE(RMPRICD,U,2)
End DoDot:1
QUIT RMPRICD
+8 ; Return Short Description
+9 SET RMPRICD=$PIECE(RMPRICD,U,4)
+10 QUIT RMPRICD
+11 ;
+12 ; Determine code set for ICD code and update appropriate return array piece
ICDCS(RMPRFNUM,RMPRANUM,RMPRIENS) ;
+1 ; RMPRFNUM = User Specified Field Number
+2 ; RMPRANUM = Array number to update
+3 ; RMPRIENS = #660 IEN
+4 NEW RMPRACS
+5 SET RMPRACS=""
+6 ; Get ICD IEN from #660
+7 SET RMPRACS=$$GET1^DIQ(660,RMPRIENS,8.8,"I",,)
+8 ; Determine Code Set for ICD code
+9 SET RMPRACS=$$CSI^ICDEX(80,RMPRACS)
+10 ; Retrieve Info for Code Set
+11 SET RMPRACS=$$SINFO^ICDEX(RMPRACS)
+12 ; Convert Code Set to external numerical value. ICD-9 = 9, ICD-10 = 10 etc.
+13 SET RMPRACS=$PIECE($PIECE(RMPRACS,U,2),"-",2)
+14 ; Update appropriate piece of return array
+15 SET $PIECE(^TMP($JOB,B),U,RMPRANUM)=$GET(RMXM(660,B_",",RMPRFNUM))_"~"_RMPRACS
+16 QUIT
+17 ;
EXIT ;common exit point
+1 QUIT
+2 ;END
