ACKQAICD ;HCIOFO/BH - Quasar utilities routine ;30 Jan 2013 3:30 PM
;;3.0;QUASAR;**21**;Feb 11, 2000;Build 40
;
ICDSYS(ACKQDOS,ACKQTYP) ; -- Get coding system
; -- input
; ackqdos = date of service (DT) default
; ackqtyp = diagnosis or procedure (DIAG) default
;
; -- output pointer to ICD Version file for coding system
;
N ACKQTYP1,IMPDATE,VERSION
I $G(ACKQDOS)="" S ACKQDOS=DT
I $G(ACKQTYP)="" S ACKQTYP1="10D"
S VERSION=1 ; Default answer
S IMPDATE=$$IMPDATE^LEXU(ACKQTYP1)
I ACKQTYP1="10D" D Q VERSION
. I ACKQDOS<IMPDATE S VERSION="1",ACKQTYP="ICD"
. I ACKQDOS'<IMPDATE S VERSION="30",ACKQTYP="10D" Q
I ACKQTYP="PROC" D Q VERSION
. I ACKQDOS<IMPDATE S VERSION="2" Q
. I ACKQDOS'<IMPDATE S VERSION="31" Q
Q $G(VERSION)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQAICD 782 printed Oct 16, 2024@18:32:23 Page 2
ACKQAICD ;HCIOFO/BH - Quasar utilities routine ;30 Jan 2013 3:30 PM
+1 ;;3.0;QUASAR;**21**;Feb 11, 2000;Build 40
+2 ;
ICDSYS(ACKQDOS,ACKQTYP) ; -- Get coding system
+1 ; -- input
+2 ; ackqdos = date of service (DT) default
+3 ; ackqtyp = diagnosis or procedure (DIAG) default
+4 ;
+5 ; -- output pointer to ICD Version file for coding system
+6 ;
+7 NEW ACKQTYP1,IMPDATE,VERSION
+8 IF $GET(ACKQDOS)=""
SET ACKQDOS=DT
+9 IF $GET(ACKQTYP)=""
SET ACKQTYP1="10D"
+10 ; Default answer
SET VERSION=1
+11 SET IMPDATE=$$IMPDATE^LEXU(ACKQTYP1)
+12 IF ACKQTYP1="10D"
Begin DoDot:1
+13 IF ACKQDOS<IMPDATE
SET VERSION="1"
SET ACKQTYP="ICD"
+14 IF ACKQDOS'<IMPDATE
SET VERSION="30"
SET ACKQTYP="10D"
QUIT
End DoDot:1
QUIT VERSION
+15 IF ACKQTYP="PROC"
Begin DoDot:1
+16 IF ACKQDOS<IMPDATE
SET VERSION="2"
QUIT
+17 IF ACKQDOS'<IMPDATE
SET VERSION="31"
QUIT
End DoDot:1
QUIT VERSION
+18 QUIT $GET(VERSION)
