RABWUTL ;HISC/SM - Billing Aware utilities ;3/24/04
;;5.0;Radiology/Nuclear Medicine;**41,70,112**;Mar 16,1998;Build 4
; BAY/KAM 03/02/2012 RA*5*112 Remedy Ticket 606685 Utilize ICD API
; Ext ref to $$ICDDX^ICDCODE sup DBIA 3990
Q
ODX(RA) ;ordering diagnosis
;RA = ien file 75.1
;RAX(n) = ien80^SC^AO^IR^SWAC^MST^SHAD^HNC^CV where pieces 2+ has 1=Y
;N RAX,RA1,I,J,RABA,RA751,X
S RA751=$S($D(RAORD0):RAORD0,1:^RAO(75.1,RA,0))
D GETDX
D WRTDX
Q
GETDX ; get DX and Clin. Indicators from file 75.1
Q:'$D(^RAO(75.1,RA,"BA")) S RAX(1)=^("BA")
S I=0,RA1=1
F S I=$O(^RAO(75.1,RA,"BAS",I)) Q:'I D
. S RA1=RA1+1
. S RAX(RA1)=^RAO(75.1,RA,"BAS",I,0)
.Q
Q
WRTDX ; write DX and Clin. Inds.
Q:'$O(RAX(0))
W !,"Ordering Diagnoses:"
S I=0
F S I=$O(RAX(I)) Q:'I D
. ;*112 remedy ticket 606685 Changed next line to use ICD API
. W !?2,$P($$ICDDX^ICDCODE(+RAX(I)),U,2),?10,$P($$ICDDX^ICDCODE(+RAX(I)),U,4)
. S X=$P(RAX(I),U,2,9)
. Q:X'["1"
. W !,?10,"Clinical Indicator(s): "
. F J=1:1:8 I $P(X,U,J) W $S(J=1:"SC",J=2:"AO",J=3:"IR",J=4:"SWAC",J=5:"MST",J=6:"HNC",J=7:"CV",1:"SHAD") W:$P(X,U,J+1,8)["1" ","
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABWUTL 1168 printed Dec 13, 2024@02:34:01 Page 2
RABWUTL ;HISC/SM - Billing Aware utilities ;3/24/04
+1 ;;5.0;Radiology/Nuclear Medicine;**41,70,112**;Mar 16,1998;Build 4
+2 ; BAY/KAM 03/02/2012 RA*5*112 Remedy Ticket 606685 Utilize ICD API
+3 ; Ext ref to $$ICDDX^ICDCODE sup DBIA 3990
+4 QUIT
ODX(RA) ;ordering diagnosis
+1 ;RA = ien file 75.1
+2 ;RAX(n) = ien80^SC^AO^IR^SWAC^MST^SHAD^HNC^CV where pieces 2+ has 1=Y
+3 ;N RAX,RA1,I,J,RABA,RA751,X
+4 SET RA751=$SELECT($DATA(RAORD0):RAORD0,1:^RAO(75.1,RA,0))
+5 DO GETDX
+6 DO WRTDX
+7 QUIT
GETDX ; get DX and Clin. Indicators from file 75.1
+1 if '$DATA(^RAO(75.1,RA,"BA"))
QUIT
SET RAX(1)=^("BA")
+2 SET I=0
SET RA1=1
+3 FOR
SET I=$ORDER(^RAO(75.1,RA,"BAS",I))
if 'I
QUIT
Begin DoDot:1
+4 SET RA1=RA1+1
+5 SET RAX(RA1)=^RAO(75.1,RA,"BAS",I,0)
+6 QUIT
End DoDot:1
+7 QUIT
WRTDX ; write DX and Clin. Inds.
+1 if '$ORDER(RAX(0))
QUIT
+2 WRITE !,"Ordering Diagnoses:"
+3 SET I=0
+4 FOR
SET I=$ORDER(RAX(I))
if 'I
QUIT
Begin DoDot:1
+5 ;*112 remedy ticket 606685 Changed next line to use ICD API
+6 WRITE !?2,$PIECE($$ICDDX^ICDCODE(+RAX(I)),U,2),?10,$PIECE($$ICDDX^ICDCODE(+RAX(I)),U,4)
+7 SET X=$PIECE(RAX(I),U,2,9)
+8 if X'["1"
QUIT
+9 WRITE !,?10,"Clinical Indicator(s): "
+10 FOR J=1:1:8
IF $PIECE(X,U,J)
WRITE $SELECT(J=1:"SC",J=2:"AO",J=3:"IR",J=4:"SWAC",J=5:"MST",J=6:"HNC",J=7:"CV",1:"SHAD")
if $PIECE(X,U,J+1,8)["1"
WRITE ","
+11 QUIT
End DoDot:1
+12 QUIT