RABWUTL.m

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 ---RABWUTL   1168     printed  Apr 09, 2024@21:42:44                                                                                                                                                                                                     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