ACKQAICD.m

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 ---ACKQAICD   782     printed  Apr 09, 2024@21:35:14                                                                                                                                                                                                     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)