- 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 Feb 18, 2025@23:58:10 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)