AMER2B.m

AMER2B ; IHS/ANMC/GIS - COST RECOVERY DATA RELATED TO INJURIES ;

 ;;3.0;ER VISIT SYSTEM;**6,7**;MAR 03, 2009;Build 5

 ; 

QD31 ; CITY OF INJURY

 S DIR("B")=$G(^TMP("AMER",$J,2,31))

 S DIR(0)="FO^1:30",DIR("A")="Town/village where injury occurred" KILL DA D ^DIR KILL DIR

 D CKSC^AMER1 I $D(AMERCKSC) K AMERCKSC G QD31

 ;

 ;AMER*3.0*6;Added call to update BEDD

 NEW INJ

 I Y'["^" S INJ=Y D

 . NEW Y

 . D INJ^AMERBEDD("INJ.PtInjury.InjLocat",INJ)

 K INJ

 ;

 D OUT^AMER

 Q

 ; 

QD32 ; TIME OF INJURY

 I $D(^TMP("AMER",$J,2,32)) S Y=^(32) X ^DD("DD") S DIR("B")=Y

 S DIR(0)="DO^::ER",DIR("A")="Enter the exact time and date of injury",DIR("?")="Enter a time and date in the usual FileMan format (e.g., 1/3/90@1PM)." D ^DIR K DIR

 I Y,$$TCK^AMER2A($G(^TMP("AMER",$J,1,2)),Y,0,"admission") K Y G QD32

 I Y="" S Y=-1

 ;

 ;AMER*3.0*6;Added call to update BEDD

 NEW INJ

 I Y'["^" S INJ=Y D

 . NEW Y

 . D INJ^AMERBEDD("INJ.PtInjury.InjDtTm",INJ)

 K INJ

 ;

 D OUT^AMER

 Q

 ;

QD33(AMERPCC,DTOUT) ; CAUSE OF INJURY

 ;

 ;Input

 ;    AMERPCC - Visit IEN (optional)

 ;        DFN - Needs to be defined

 ;

 ;Returns DTOUT on timeouts

 ;

 NEW DIR,DUOUT,DIRUT,DIROUT,INP,VDT,LEX,QUIT,SELECT,TOTREC,SEX,RET

 NEW CAUSE,EDIT

 I $G(AMERPCC)="" S AMERPCC=$$GET1^DIQ(9009081,DFN_",",1.1,"I")

 I AMERPCC]"" S VDT=$P($$GET1^DIQ(9000010,AMERPCC,.01,"I"),".")

 S:$G(VDT)="" VDT=DT

 S SEX=$$GET1^DIQ(2,DFN_",",.02,"I")

 ;

 ;Get the current cause of injury

 I $G(AMERDA)]"" S CAUSE=$$GET1^DIQ(9009080,AMERDA_",",3.2,"I")

 I $G(CAUSE)="" S CAUSE=$G(^TMP("AMER",$J,2,33))

 ;

 ;If current value, display and check for edit

 S EDIT="" I CAUSE]"" D  I 'EDIT G XQD33

 . NEW DESC,DIR,DUOUT,DTOUT

 . ;

 . ;Get the current display value

 . S DESC=$$DX^AMERPOV(CAUSE,"",1,VDT) Q:DESC=""

 . W !!,"Current Cause of injury: ",DESC,!

 . S DIR("B")="NO"

 . S DIR(0)="YO",DIR("A")="Change cause of injury to new value"

 . D ^DIR

 . I Y=1 S EDIT=1 Q

 . ;

 . ;Process timeouts and "^"

 . I $D(DUOUT) S (X,Y)="^" Q

 . I $D(DTOUT) S (X,Y)="^" Q

 . ;

 . ;Do not change - plug in current value

 . S Y=CAUSE Q

 ;

QD33E S DIR(0)="F^3"

 ;S (X,Y)=""

 S DIR("A")="*Cause of injury"

 S DIR("?")="Enter a string or ICD code for the Cause of Injury"

 D ^DIR

 I $D(DIRUT) S X="^" Q

 ;

 ;Perform the lookup

 ;

 ;Call parameters

 ;P1-Search Text, P2-Return Count, P3-Search Type (0-No COI, 1-Only COI, 2-All),P4-Date,P5-Gender

 ;S INP=Y_"^1^"_VDT_"^"_SEX_"^2^0"

 D LEX^AMERUTIL(Y,100,1,VDT,SEX,.RET)

 ;

 ;Reprompt if no results

 I $O(RET(""))="" W !!,"<No results returned. Please try a different search string>",! H 2 K RET G QD33E

 ;

 ;Convert results to ICD

 K ^TMP("AMERICD",$J)

 S TOTREC=0,LEX="" F  S LEX=$O(RET(LEX)) Q:LEX=""  I +LEX S TOTREC=TOTREC+1,^TMP("AMERICD",$J,TOTREC)=RET(LEX)

 ;

 ;Display Results

 S SELECT=""

 W !!

 S (QUIT,LEX)=0 F  S LEX=$O(^TMP("AMERICD",$J,LEX)) Q:LEX=""  D  Q:QUIT>1  Q:SELECT]""

 . ;

 . NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,ND

 . ;

 . ;Display one entry

 . S ND=$G(^TMP("AMERICD",$J,LEX)) Q:$TR(ND,"^")=""

 . W !,LEX,?4,$P(ND,U,2),?14,$E($P(ND,U,3),1,64)

 . ;

 . ;Prompt every 5 entries

 . I LEX#5'=0,LEX'=+TOTREC Q

 . W !,"Press <RETURN> to see more, '^' to exit this list, OR"

 . S DIR("A")="CHOOSE 1-"_LEX_": "

 . S DIR(0)="NOA^1:"_LEX

 . D ^DIR

 . S QUIT=$$CKANS() Q:QUIT

 . ;

 . ;Record the selection

 . S:+Y SELECT=+Y

 ;

 ;Handle "^", "^^", timeouot

 I QUIT=2 K RET G QD33E

 I QUIT=3 S (Y,X)="^" Q

 I SELECT="" K RET G QD33E

 ;

 ;Set entry

 S Y=$P($G(^TMP("AMERICD",$J,+SELECT)),U)

 ;

 ;AMER*3.0*6;Added call to update BEDD

 NEW INJ

 ;AMER*3.0*7;Added in DO

 ;I Y'["^" S INJ=Y

 I Y'["^" S INJ=Y D

 . NEW Y

 . D INJ^AMERBEDD("INJ.PtInjury.InjCauseIEN",INJ)

 K INJ

 ;

XQD33 D OUT^AMER

 Q

 ;

QD34 ; PLACE OF INJURY

 S DIC("A")="Setting of accident/injury: " K DIC("B")

 I $D(^TMP("AMER",$J,2,34)) S %=+^(34) S:%>0 DIC("B")=$P(^AMER(3,%,0),U)

 S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SCENE OF INJURY"),DIC(0)="AEQ"

 D ^DIC K DIC S Y=+Y

 ;

 ;AMER*3.0*6;Added call to update BEDD

 NEW INJ

 ;AMER*3.0*7;Added in DO

 ;I +Y>0 S INJ=Y

 I +Y>0 S INJ=Y D

 . NEW Y

 . D INJ^AMERBEDD("INJ.PtInjury.InjSet",INJ)

 K INJ

 ; 

 D OUT^AMER

 ;

 ;No longer in use

 ;S Z=U,%="MOTOR VEHICLE^BICYCLE^TOOLS JOB EQUIP.^INHILATION (GAS/SMOKE)^CHEMICALS (CAUSTIC OR TOXIC)^ELECTRICITY^FIRE FLAME^FALL (ACCIDENTAL)" F I=1:1:$L(%,U) S A=$P(%,U,I),Z=Z_+$O(^AMER(3,"B",A,0))_U

 ;S %=$P($G(^TMP("AMER",$J,2,33)),U) I Z'[(U_%_U) G QD35A ; SAFETY EQUIP NOT RELEVANT

 Q

 ;

QD35 ; SAFETY EQUIPMENT OF INJURY

 N A,Z,%

 S DIC("A")="Safety equipment used: " K DIC("B")

 I $D(^TMP("AMER",$J,2,35)) S %=+^(35) S:%>0 DIC("B")=$P(^AMER(3,%,0),U)

 S DIC="^AMER(3,",DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SAFETY EQUIPMENT"),DIC(0)="AEQ"

 D ^DIC K DIC S Y=+Y

 ;

 ;AMER*3.0*6;Added call to update BEDD

 NEW INJ

 ;AMER*3.0*7;Added in DO

 ;I +Y>0 S INJ=Y

 I +Y>0 S INJ=Y D

 . NEW Y

 . D INJ^AMERBEDD("INJ.PtInjury.SafetyEquip",INJ)

 K INJ

 ;

 D OUT^AMER I $D(AMERQUIT) Q

QD35A ;

 ;

 NEW MVA

 ;

 S MVA=""

 ;

 ;Look for MVA

 I $G(AMERDFN)]"" D

 . NEW DESC,%,I

 . S %=$P($G(^TMP("AMER",$J,2,33)),U)

 . S DESC=$$DESC(%,AMERDFN,"","")

 . F I="MOTOR","VEH","MV","TRAFFIC" I $$UP^XLFSTR(DESC)[I S MVA=1

 ;

 ;If MVA ask additional questions

 I MVA=1 D  Q  ; MVA

 . S AMERRUN=40

 . F I=61:1:64 K ^TMP("AMER",$J,2,I) ; MVA

 . Q

 ;

 ;Not a MVA

 F I=41:1:46,51:1:57,61:1:64 K ^TMP("AMER",$J,2,I)

 I $D(AMEREFLG) S AMERRUN=99

 E  S AMERRUN=4

 Q

 ;

QD41 ; DESCIPTION OF MVA LOCATION

 K DIR("B") I $D(^TMP("AMER",$J,2,41)) S DIR("B")=^(41)

 S DIR(0)="FO^1:100",DIR("A")="Location of MVC (if applicable)",DIR("?")="Enter free text location description (100 characters max.)" D ^DIR K DIR

 D CKSC^AMER1 I $D(AMERCKSC) K AMERCKSC G QD41

 D OUT^AMER I $D(AMERQUIT) Q

 S AMERRUN=4

 Q

 ;

CKANS()  ;EP - Check answer "^", "^^", and timeout

 ;

 ;User typed "^^"

 I $G(DIROUT) Q 3

 ;

 ;User typed "^" or timed out

 I $G(DUOUT)!$G(DTOUT) Q 2

 ;

 ;User hit ENTER

 I $G(DIRUT) Q 1

 ;

 Q 0

 ;

DESC(X,D0,CODE,VDATE) ;Return the ICD Description

 ;

 NEW ICDDESC

 ;

 ;Make the call to get the string

 S ICDDESC=$$DX^AMERPOV($G(X),$G(D0),$G(CODE),$G(VDATE))

 Q ICDDESC

AMER2B    ; IHS/ANMC/GIS - COST RECOVERY DATA RELATED TO INJURIES ;

 +1       ;;3.0;ER VISIT SYSTEM;**6,7**;MAR 03, 2009;Build 5

 +2       ; 

QD31      ; CITY OF INJURY

 +1        SET DIR("B")=$GET(^TMP("AMER",$JOB,2,31))

 +2        SET DIR(0)="FO^1:30"

           SET DIR("A")="Town/village where injury occurred"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        DO CKSC^AMER1

           IF $DATA(AMERCKSC)

               KILL AMERCKSC

               GOTO QD31

 +4       ;

 +5       ;AMER*3.0*6;Added call to update BEDD

 +6        NEW INJ

 +7        IF Y'["^"

               SET INJ=Y

               Begin DoDot:1

 +8                NEW Y

 +9                DO INJ^AMERBEDD("INJ.PtInjury.InjLocat",INJ)

               End DoDot:1

 +10       KILL INJ

 +11      ;

 +12       DO OUT^AMER

 +13       QUIT 

 +14      ; 

QD32      ; TIME OF INJURY

 +1        IF $DATA(^TMP("AMER",$JOB,2,32))

               SET Y=^(32)

               XECUTE ^DD("DD")

               SET DIR("B")=Y

 +2        SET DIR(0)="DO^::ER"

           SET DIR("A")="Enter the exact time and date of injury"

           SET DIR("?")="Enter a time and date in the usual FileMan format (e.g., 1/3/90@1PM)."

           DO ^DIR

           KILL DIR

 +3        IF Y

               IF $$TCK^AMER2A($GET(^TMP("AMER",$JOB,1,2)),Y,0,"admission")

                   KILL Y

                   GOTO QD32

 +4        IF Y=""

               SET Y=-1

 +5       ;

 +6       ;AMER*3.0*6;Added call to update BEDD

 +7        NEW INJ

 +8        IF Y'["^"

               SET INJ=Y

               Begin DoDot:1

 +9                NEW Y

 +10               DO INJ^AMERBEDD("INJ.PtInjury.InjDtTm",INJ)

               End DoDot:1

 +11       KILL INJ

 +12      ;

 +13       DO OUT^AMER

 +14       QUIT 

 +15      ;

QD33(AMERPCC,DTOUT) ; CAUSE OF INJURY

 +1       ;

 +2       ;Input

 +3       ;    AMERPCC - Visit IEN (optional)

 +4       ;        DFN - Needs to be defined

 +5       ;

 +6       ;Returns DTOUT on timeouts

 +7       ;

 +8        NEW DIR,DUOUT,DIRUT,DIROUT,INP,VDT,LEX,QUIT,SELECT,TOTREC,SEX,RET

 +9        NEW CAUSE,EDIT

 +10       IF $GET(AMERPCC)=""

               SET AMERPCC=$$GET1^DIQ(9009081,DFN_",",1.1,"I")

 +11       IF AMERPCC]""

               SET VDT=$PIECE($$GET1^DIQ(9000010,AMERPCC,.01,"I"),".")

 +12       IF $GET(VDT)=""

               SET VDT=DT

 +13       SET SEX=$$GET1^DIQ(2,DFN_",",.02,"I")

 +14      ;

 +15      ;Get the current cause of injury

 +16       IF $GET(AMERDA)]""

               SET CAUSE=$$GET1^DIQ(9009080,AMERDA_",",3.2,"I")

 +17       IF $GET(CAUSE)=""

               SET CAUSE=$GET(^TMP("AMER",$JOB,2,33))

 +18      ;

 +19      ;If current value, display and check for edit

 +20       SET EDIT=""

           IF CAUSE]""

               Begin DoDot:1

 +21               NEW DESC,DIR,DUOUT,DTOUT

 +22      ;

 +23      ;Get the current display value

 +24               SET DESC=$$DX^AMERPOV(CAUSE,"",1,VDT)

                   IF DESC=""

                       QUIT 

 +25               WRITE !!,"Current Cause of injury: ",DESC,!

 +26               SET DIR("B")="NO"

 +27               SET DIR(0)="YO"

                   SET DIR("A")="Change cause of injury to new value"

 +28               DO ^DIR

 +29               IF Y=1

                       SET EDIT=1

                       QUIT 

 +30      ;

 +31      ;Process timeouts and "^"

 +32               IF $DATA(DUOUT)

                       SET (X,Y)="^"

                       QUIT 

 +33               IF $DATA(DTOUT)

                       SET (X,Y)="^"

                       QUIT 

 +34      ;

 +35      ;Do not change - plug in current value

 +36               SET Y=CAUSE

                   QUIT 

               End DoDot:1

               IF 'EDIT

                   GOTO XQD33

 +37      ;

QD33E      SET DIR(0)="F^3"

 +1       ;S (X,Y)=""

 +2        SET DIR("A")="*Cause of injury"

 +3        SET DIR("?")="Enter a string or ICD code for the Cause of Injury"

 +4        DO ^DIR

 +5        IF $DATA(DIRUT)

               SET X="^"

               QUIT 

 +6       ;

 +7       ;Perform the lookup

 +8       ;

 +9       ;Call parameters

 +10      ;P1-Search Text, P2-Return Count, P3-Search Type (0-No COI, 1-Only COI, 2-All),P4-Date,P5-Gender

 +11      ;S INP=Y_"^1^"_VDT_"^"_SEX_"^2^0"

 +12       DO LEX^AMERUTIL(Y,100,1,VDT,SEX,.RET)

 +13      ;

 +14      ;Reprompt if no results

 +15       IF $ORDER(RET(""))=""

               WRITE !!,"<No results returned. Please try a different search string>",!

               HANG 2

               KILL RET

               GOTO QD33E

 +16      ;

 +17      ;Convert results to ICD

 +18       KILL ^TMP("AMERICD",$JOB)

 +19       SET TOTREC=0

           SET LEX=""

           FOR 

               SET LEX=$ORDER(RET(LEX))

               IF LEX=""

                   QUIT 

               IF +LEX

                   SET TOTREC=TOTREC+1

                   SET ^TMP("AMERICD",$JOB,TOTREC)=RET(LEX)

 +20      ;

 +21      ;Display Results

 +22       SET SELECT=""

 +23       WRITE !!

 +24       SET (QUIT,LEX)=0

           FOR 

               SET LEX=$ORDER(^TMP("AMERICD",$JOB,LEX))

               IF LEX=""

                   QUIT 

               Begin DoDot:1

 +25      ;

 +26               NEW DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y,ND

 +27      ;

 +28      ;Display one entry

 +29               SET ND=$GET(^TMP("AMERICD",$JOB,LEX))

                   IF $TRANSLATE(ND,"^")=""

                       QUIT 

 +30               WRITE !,LEX,?4,$PIECE(ND,U,2),?14,$EXTRACT($PIECE(ND,U,3),1,64)

 +31      ;

 +32      ;Prompt every 5 entries

 +33               IF LEX#5'=0

                       IF LEX'=+TOTREC

                           QUIT 

 +34               WRITE !,"Press <RETURN> to see more, '^' to exit this list, OR"

 +35               SET DIR("A")="CHOOSE 1-"_LEX_": "

 +36               SET DIR(0)="NOA^1:"_LEX

 +37               DO ^DIR

 +38               SET QUIT=$$CKANS()

                   IF QUIT

                       QUIT 

 +39      ;

 +40      ;Record the selection

 +41               IF +Y

                       SET SELECT=+Y

               End DoDot:1

               IF QUIT>1

                   QUIT 

               IF SELECT]""

                   QUIT 

 +42      ;

 +43      ;Handle "^", "^^", timeouot

 +44       IF QUIT=2

               KILL RET

               GOTO QD33E

 +45       IF QUIT=3

               SET (Y,X)="^"

               QUIT 

 +46       IF SELECT=""

               KILL RET

               GOTO QD33E

 +47      ;

 +48      ;Set entry

 +49       SET Y=$PIECE($GET(^TMP("AMERICD",$JOB,+SELECT)),U)

 +50      ;

 +51      ;AMER*3.0*6;Added call to update BEDD

 +52       NEW INJ

 +53      ;AMER*3.0*7;Added in DO

 +54      ;I Y'["^" S INJ=Y

 +55       IF Y'["^"

               SET INJ=Y

               Begin DoDot:1

 +56               NEW Y

 +57               DO INJ^AMERBEDD("INJ.PtInjury.InjCauseIEN",INJ)

               End DoDot:1

 +58       KILL INJ

 +59      ;

XQD33      DO OUT^AMER

 +1        QUIT 

 +2       ;

QD34      ; PLACE OF INJURY

 +1        SET DIC("A")="Setting of accident/injury: "

           KILL DIC("B")

 +2        IF $DATA(^TMP("AMER",$JOB,2,34))

               SET %=+^(34)

               IF %>0

                   SET DIC("B")=$PIECE(^AMER(3,%,0),U)

 +3        SET DIC="^AMER(3,"

           SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SCENE OF INJURY")

           SET DIC(0)="AEQ"

 +4        DO ^DIC

           KILL DIC

           SET Y=+Y

 +5       ;

 +6       ;AMER*3.0*6;Added call to update BEDD

 +7        NEW INJ

 +8       ;AMER*3.0*7;Added in DO

 +9       ;I +Y>0 S INJ=Y

 +10       IF +Y>0

               SET INJ=Y

               Begin DoDot:1

 +11               NEW Y

 +12               DO INJ^AMERBEDD("INJ.PtInjury.InjSet",INJ)

               End DoDot:1

 +13       KILL INJ

 +14      ; 

 +15       DO OUT^AMER

 +16      ;

 +17      ;No longer in use

 +18      ;S Z=U,%="MOTOR VEHICLE^BICYCLE^TOOLS JOB EQUIP.^INHILATION (GAS/SMOKE)^CHEMICALS (CAUSTIC OR TOXIC)^ELECTRICITY^FIRE FLAME^FALL (ACCIDENTAL)" F I=1:1:$L(%,U) S A=$P(%,U,I),Z=Z_+$O(^AMER(3,"B",A,0))_U

 +19      ;S %=$P($G(^TMP("AMER",$J,2,33)),U) I Z'[(U_%_U) G QD35A ; SAFETY EQUIP NOT RELEVANT

 +20       QUIT 

 +21      ;

QD35      ; SAFETY EQUIPMENT OF INJURY

 +1        NEW A,Z,%

 +2        SET DIC("A")="Safety equipment used: "

           KILL DIC("B")

 +3        IF $DATA(^TMP("AMER",$JOB,2,35))

               SET %=+^(35)

               IF %>0

                   SET DIC("B")=$PIECE(^AMER(3,%,0),U)

 +4        SET DIC="^AMER(3,"

           SET DIC("S")="I $P(^(0),U,2)="_$$CAT^AMER0("SAFETY EQUIPMENT")

           SET DIC(0)="AEQ"

 +5        DO ^DIC

           KILL DIC

           SET Y=+Y

 +6       ;

 +7       ;AMER*3.0*6;Added call to update BEDD

 +8        NEW INJ

 +9       ;AMER*3.0*7;Added in DO

 +10      ;I +Y>0 S INJ=Y

 +11       IF +Y>0

               SET INJ=Y

               Begin DoDot:1

 +12               NEW Y

 +13               DO INJ^AMERBEDD("INJ.PtInjury.SafetyEquip",INJ)

               End DoDot:1

 +14       KILL INJ

 +15      ;

 +16       DO OUT^AMER

           IF $DATA(AMERQUIT)

               QUIT 

QD35A     ;

 +1       ;

 +2        NEW MVA

 +3       ;

 +4        SET MVA=""

 +5       ;

 +6       ;Look for MVA

 +7        IF $GET(AMERDFN)]""

               Begin DoDot:1

 +8                NEW DESC,%,I

 +9                SET %=$PIECE($GET(^TMP("AMER",$JOB,2,33)),U)

 +10               SET DESC=$$DESC(%,AMERDFN,"","")

 +11               FOR I="MOTOR","VEH","MV","TRAFFIC"

                       IF $$UP^XLFSTR(DESC)[I

                           SET MVA=1

               End DoDot:1

 +12      ;

 +13      ;If MVA ask additional questions

 +14      ; MVA

           IF MVA=1

               Begin DoDot:1

 +15               SET AMERRUN=40

 +16      ; MVA

                   FOR I=61:1:64

                       KILL ^TMP("AMER",$JOB,2,I)

 +17               QUIT 

               End DoDot:1

               QUIT 

 +18      ;

 +19      ;Not a MVA

 +20       FOR I=41:1:46,51:1:57,61:1:64

               KILL ^TMP("AMER",$JOB,2,I)

 +21       IF $DATA(AMEREFLG)

               SET AMERRUN=99

 +22      IF '$TEST

               SET AMERRUN=4

 +23       QUIT 

 +24      ;

QD41      ; DESCIPTION OF MVA LOCATION

 +1        KILL DIR("B")

           IF $DATA(^TMP("AMER",$JOB,2,41))

               SET DIR("B")=^(41)

 +2        SET DIR(0)="FO^1:100"

           SET DIR("A")="Location of MVC (if applicable)"

           SET DIR("?")="Enter free text location description (100 characters max.)"

           DO ^DIR

           KILL DIR

 +3        DO CKSC^AMER1

           IF $DATA(AMERCKSC)

               KILL AMERCKSC

               GOTO QD41

 +4        DO OUT^AMER

           IF $DATA(AMERQUIT)

               QUIT 

 +5        SET AMERRUN=4

 +6        QUIT 

 +7       ;

CKANS()   ;EP - Check answer "^", "^^", and timeout

 +1       ;

 +2       ;User typed "^^"

 +3        IF $GET(DIROUT)

               QUIT 3

 +4       ;

 +5       ;User typed "^" or timed out

 +6        IF $GET(DUOUT)!$GET(DTOUT)

               QUIT 2

 +7       ;

 +8       ;User hit ENTER

 +9        IF $GET(DIRUT)

               QUIT 1

 +10      ;

 +11       QUIT 0

 +12      ;

DESC(X,D0,CODE,VDATE) ;Return the ICD Description

 +1       ;

 +2        NEW ICDDESC

 +3       ;

 +4       ;Make the call to get the string

 +5        SET ICDDESC=$$DX^AMERPOV($GET(X),$GET(D0),$GET(CODE),$GET(VDATE))

 +6        QUIT ICDDESC