Routine: ACKQUTL7

ACKQUTL7 ;HCIOFO/BH - Template Inquire - A&SP Patient/Visit ;18 Jun 2013  10:54 AM

 ;;3.0;QUASAR;**8,22,21**;Feb 11, 2000;Build 40

 ; Reference/IA

 ;  $$CSI^ICDEX - 5747

INP ;  PRINT INPATIENT INFO

 W !,"WARD: ",ACK(6),?20,"ROOM/BED: ",ACK(7),?40,"TREATING SPEC:"

 W $E(ACK(8),1,25)

EN ;  Get Demographics

 N I,X,Y K ACKDIRUT

 D DEM^VADPT,INP^VADPT,ELIG^VADPT

 S ACKIVD=$$NUMDT^ACKQUTL($P(^ACK(509850.2,ACKPAT,0),U,2))

 K ACK S ACK(1)=VADM(1),ACK(2)=$P(VADM(3),U,2),ACK(3)=$P(VADM(2),U,2)

 S ACK(4)=VADM(7),ACK(6)=$P(VAIN(4),U,2)

 S ACKINP=$S($L(ACK(6)):1,1:0),ACK(5)="Patient is "_$S(ACKINP:"",1:"not ")_"currently an inpatient."

 S ACK(7)=VAIN(5),ACK(8)=$P(VAIN(3),U,2),ACK(9)=$P(VAEL(1),U,2)

PRINT ;

 W @IOF

 S X="QUASAR V.3.  "_ACKVISIT_" VISIT ENTRY" D CNTR^ACKQUTL(X)

 D TPLTE

 ;  D RATDIS^ACKQNQ  ;  Display any Rated Disabilities

 W !!,"Patient Diagnostic History",!

 W $S($P(VADM(5),U)="F":"Ms. ",1:"Mr. "),$P(VADM(1),",")

 W " has been seen for the following:",!

 I $Y>(IOSL-8) S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)  W @IOF

 D DIHEAD,ICDSORT

 K DIRUT W !

 I $D(ACKICD)'=11 W !,"No A&SP Diagnostic Data for this Patient" G EXIT

 S ACKI=""

 ;F  S ACKI=$O(ACKICD(ACKI)) Q:ACKI=""  D:$Y>(IOSL-5) WAIT Q:$D(DIRUT)  W !,$P(ACKICD(ACKI),U),?15,$P(ACKICD(ACKI),U,3),?60,$$NUMDT^ACKQUTL($P(ACKICD(ACKI),U,4))

 S ACKICDX=""

 F  S ACKI=$O(ACKICD(ACKI)) Q:ACKI=""  D:$Y>(IOSL-5) WAIT Q:$D(DIRUT)  D

 . S ACKICDX=""

 . S ACKICDX=$O(ACKICD(ACKI,ACKICDX))

 . S ACKCDST(ACKICDX)=ACKICDX

 I $D(ACKCDST(1)),$D(ACKCDST(30)) D

 . S ACKI="",CNTR9=0,CNTR0=0

 . F  S ACKI=$O(ACKICD(ACKI)) Q:ACKI=""  D

 . . S ACKICD=""

 . . F  S ACKICD=$O(ACKICD(ACKI,ACKICD)) Q:ACKICD=""  D

 . . . S ACKDX=$P(ACKICD(ACKI,ACKICD),U)

 . . . S ACKDESC=$P(ACKICD(ACKI,ACKICD),U,3)

 . . . S ACKDATE=$$NUMDT^ACKQUTL($P(ACKICD(ACKI,ACKICD),U,4))

 . . . I ACKICD=1 S CNTR9=CNTR9+1 S ACKICD9(CNTR9)=ACKDX_U_ACKDESC_U_ACKDATE

 . . . I ACKICD=30 S CNTR0=CNTR0+1 S ACKICD0(CNTR0)=ACKDX_U_ACKDESC_U_ACKDATE

 . D PRTHEAD,EXIT Q

 S ACKI="" F  S ACKI=$O(ACKICD(ACKI)) Q:ACKI=""  D:$Y>(IOSL-5) WAIT Q:$D(DIRUT)  D

 . S ACKICDX=""

 . S ACKICDX=$O(ACKICD(ACKI,ACKICDX)) D

 . . W !,$P(ACKICD(ACKI,ACKICDX),U),?10,$P(ACKICD(ACKI,ACKICDX),U,3),?72,$$NUMDT^ACKQUTL($P(ACKICD(ACKI,ACKICDX),U,4))

EXIT ;

 I $G(DIRUT)=1 S ACKDIRUT=1  ;  Quit flag for template

 W !!

 K %ZIS,ACK,ACKCDST,ACKDC,ACKDD,ACKDESC,ACKDFN,ACKDN,ACKDX,ACKI,ACKICD,ACKINP,ACKIVD,ACKLINE

 K ACKRD,ACKDATE,ACKICD0,ACKICD9,ACKICDX,ACKINFO

 K CNTR0,CNTR9,DATA,DIRUT,DTOUT,DUOUT,VA,VADM,VAEL,VAERR,VAIN,X,X1,Y,ZTDESC,ZTIO

 K ZTRTN,ZTSAVE

 W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

WAIT ;

 K DIRUT I $E(IOST)'="C" W @IOF Q

 S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)  W @IOF,"Patient Diagnostic History (Cont'd)","  (",ACK(1),")" D DIHEAD

DIHEAD ;

 W ?72,"DATE"

 W !,"DIAGNOSIS",?72,"ENTERED" S ACKLINE="",$P(ACKLINE,"-",IOM)="" W !,ACKLINE

ICDSORT ;

 S ACKI=0 F  S ACKI=$O(^ACK(509850.2,DFN,1,ACKI)) Q:'ACKI  D

 . S ACKDC=^ACK(509850.2,DFN,1,ACKI,0),ACKDD=$P(ACKDC,U,2)

 . S ACKICD=$$CSI^ICDEX(80,+ACKDC) ; returns 1 for ICD9 and 30 for ICD10

 . S ACKINFO=$$ICDDATA^ICDXCODE(ACKICD,+ACKDC,ACKDD,"I")

 . S ACKTGT=$P(ACKINFO,U,3)

 . S ACKDN=$P(ACKINFO,U,2)

 . S ACKICD(ACKDN,ACKICD)=ACKDN_U_ACKTGT_U_$$DIAGTXT^ACKQUTL8(+ACKDC,ACKDD)_U_ACKDD

 K ACKTGT,ACKMSG

TPLTE ;  Display Visit Clinic and Division

 N ACKTMPE

 W !!,"CLINIC: ",$$GET1^DIQ(509850.6,ACKVIEN,"2.6")

 W ?45,"DIVISION: ",$$GET1^DIQ(509850.6,ACKVIEN,60),!

 ;  Display more Patient data

 W "PATIENT: ",ACK(1),?45,"DOB: ",ACK(2),?63,"SSN: ",ACK(3)

 ;  If no Visit Eligibility on visit file display Primary Elig.

 S ACKTMPE=$$GET1^DIQ(509850.6,ACKVIEN_",",80,"E")

 I ACKTMPE D

 . W !,"VISIT ELIGIBILITY: "_ACKTMPE

 I 'ACKTMPE D

 .W !,"ELIGIBILITY: ",ACK(9)

 W ?45,"INITIAL VISIT DATE: ",ACKIVD

 W:$L(ACK(4)) !,ACK(4) W !,ACK(5) D:ACKINP INP

 ;  D VISIT

VISIT ;  Displays Service connected data

 I 'ACKSC Q        ;  If Patient not service connected QUIT

 I 'ACKPCE Q       ;  If system not set up for PCE then QUIT

 N ACKX,ACKVV,ACKPP,ACKVSC,ACKAAO,ACKEENV,ACKRRAD,ACK,ACKSTR

 D GETDATA

 I ACKVISIT="NEW",$G(ACKPCENO)="" D UNKNOWN Q

 I 'ACKVSC D NOT("This Visit's Treatment :",ACKAAO,ACKRRAD,ACKEENV) Q

 I ACKVSC D CONNECT

GETDATA ;  Get visit data

 K ACK

 D GETS^DIQ(509850.6,ACKVIEN,"20;25;30;35","I","ACK")

 S ACKVSC=ACK(509850.6,ACKVIEN_",",20,"I")

 S ACKAAO=ACK(509850.6,ACKVIEN_",",25,"I")

 S ACKEENV=ACK(509850.6,ACKVIEN_",",35,"I")

 S ACKRRAD=ACK(509850.6,ACKVIEN_",",30,"I")

 K ACK

CONNECT W !!,"This visit's Treatment is Service Connected.",!

NOT(ACKSTR,ACKAAO,ACKRRAD,ACKEENV) ;

 W !!,ACKSTR,!

 W "------------------------------------------------------------------------------"

 W !,"Related to AGENT ORANGE ? : "_$S(ACKAAO="1":"YES",1:"NO") W ?50,"Service Connected ? : NO"

 W !,"Related to RADIATION EXPOSURE ? : "_$S(ACKRRAD="1":"YES",1:"NO")

 W !,"Related to ENVIRONMENTAL CONTAMINANTS ? : "_$S(ACKEENV="1":"YES",1:"NO")

UNKNOWN N ACKPASS

 S ACKPASS=0

 W !!,"This visit's Treatment:",!

 W "------------------------------------------------------------------------------",!

 I ACKAO W "Related to AGENT ORANGE ? : UNKNOWN" D:'ACKPASS SERV

 I ACKRAD W !,"Related to RADIATION EXPOSURE ? : UNKNOWN" D:'ACKPASS SERV

 I ACKENV W !,"Related to ENVIRONMENTAL CONTAMINANTS ? : UNKNOWN" D:'ACKPASS SERV

 D:'ACKPASS SERV

W !

SERV ;

 W ?50,"Service Connected ? : UNKNOWN" S ACKPASS=1

ERROR ; Display error message if registration returns error that indicates

 ; that the Appointment Management database is not available.

 N ACKERR

 W !!!!,"   ** The Appointment Management Data Base is unavailable. **"

 W !!,"   ** Please report this problem to IRM as soon as possible. **",!!!

 W "   Press any key to continue."

 R ACKERR:DTIME

PRTHEAD ;

 S CNTR9=0,CNTR0=0

 W !,"ICD-9-CM",!

 F CNTR9=1:1 S DATA=$G(ACKICD9(CNTR9)) Q:'$D(ACKICD9(CNTR9))  D

 . S ACKDX=$P(DATA,U)

 . S ACKDESC=$P(DATA,U,2)

 . S ACKDATE=$P(DATA,U,3)

 . K ACKICDDS,ACKARNUM S ACKICDDS=ACKDESC D BRKDESC^ACKQR3(57)

 . ;W !,ACKDX,?10,ACKDESC,?72,ACKDATE

 . W !,ACKDX,?10,ACKICDDS(1),?71,ACKDATE

 . F ACKARNM2=2:1:ACKARNUM W !?10,ACKICDDS(ACKARNM2)

 . K ACKICDDS,ACKARNUM,ACKARNM2

 W !!,"ICD-10-CM",!

 F CNTR0=1:1 S DATA=$G(ACKICD0(CNTR0)) Q:'$D(ACKICD0(CNTR0))  D

 . S ACKDX=$P(DATA,U)

 . S ACKDESC=$P(DATA,U,2)

 . S ACKDATE=$P(DATA,U,3)

 . K ACKICDDS,ACKARNUM S ACKICDDS=ACKDESC D BRKDESC^ACKQR3(57)

 . ;W !,ACKDX,?10,ACKDESC,?72,ACKDATE

 . W !,ACKDX,?10,ACKICDDS(1),?71,ACKDATE

 . F ACKARNM2=2:1:ACKARNUM W !?10,ACKICDDS(ACKARNM2)

 . K ACKICDDS,ACKARNUM,ACKARNM2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQUTL7   6866     printed  Mar 13, 2025@21:38:02                                                                                                                                                                                                    Page 2

ACKQUTL7  ;HCIOFO/BH - Template Inquire - A&SP Patient/Visit ;18 Jun 2013  10:54 AM

 +1       ;;3.0;QUASAR;**8,22,21**;Feb 11, 2000;Build 40

 +2       ;

 +3       ; Reference/IA

 +4       ;  $$CSI^ICDEX - 5747

 +5       ;

INP       ;  PRINT INPATIENT INFO

 +1        WRITE !,"WARD: ",ACK(6),?20,"ROOM/BED: ",ACK(7),?40,"TREATING SPEC:"

 +2        WRITE $EXTRACT(ACK(8),1,25)

 +3        QUIT

 +4       ;

 +5       ;

EN        ;  Get Demographics

 +1        NEW I,X,Y

           KILL ACKDIRUT

 +2        DO DEM^VADPT

           DO INP^VADPT

           DO ELIG^VADPT

 +3        SET ACKIVD=$$NUMDT^ACKQUTL($PIECE(^ACK(509850.2,ACKPAT,0),U,2))

 +4        KILL ACK

           SET ACK(1)=VADM(1)

           SET ACK(2)=$PIECE(VADM(3),U,2)

           SET ACK(3)=$PIECE(VADM(2),U,2)

 +5        SET ACK(4)=VADM(7)

           SET ACK(6)=$PIECE(VAIN(4),U,2)

 +6        SET ACKINP=$SELECT($LENGTH(ACK(6)):1,1:0)

           SET ACK(5)="Patient is "_$SELECT(ACKINP:"",1:"not ")_"currently an inpatient."

 +7        SET ACK(7)=VAIN(5)

           SET ACK(8)=$PIECE(VAIN(3),U,2)

           SET ACK(9)=$PIECE(VAEL(1),U,2)

PRINT     ;

 +1        WRITE @IOF

 +2        SET X="QUASAR V.3.  "_ACKVISIT_" VISIT ENTRY"

           DO CNTR^ACKQUTL(X)

 +3       ;

 +4       ;

 +5        DO TPLTE

 +6       ;

 +7       ;

 +8       ;  D RATDIS^ACKQNQ  ;  Display any Rated Disabilities

 +9       ;

 +10       WRITE !!,"Patient Diagnostic History",!

 +11       WRITE $SELECT($PIECE(VADM(5),U)="F":"Ms. ",1:"Mr. "),$PIECE(VADM(1),",")

 +12       WRITE " has been seen for the following:",!

 +13       IF $Y>(IOSL-8)

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

               if $DATA(DIRUT)

                   QUIT

               WRITE @IOF

 +14       DO DIHEAD

           DO ICDSORT

 +15       KILL DIRUT

           WRITE !

 +16       IF $DATA(ACKICD)'=11

               WRITE !,"No A&SP Diagnostic Data for this Patient"

               GOTO EXIT

 +17       SET ACKI=""

 +18      ;F  S ACKI=$O(ACKICD(ACKI)) Q:ACKI=""  D:$Y>(IOSL-5) WAIT Q:$D(DIRUT)  W !,$P(ACKICD(ACKI),U),?15,$P(ACKICD(ACKI),U,3),?60,$$NUMDT^ACKQUTL($P(ACKICD(ACKI),U,4))

 +19       SET ACKICDX=""

 +20       FOR

               SET ACKI=$ORDER(ACKICD(ACKI))

               if ACKI=""

                   QUIT

               if $Y>(IOSL-5)

                   DO WAIT

               if $DATA(DIRUT)

                   QUIT

               Begin DoDot:1

 +21               SET ACKICDX=""

 +22               SET ACKICDX=$ORDER(ACKICD(ACKI,ACKICDX))

 +23               SET ACKCDST(ACKICDX)=ACKICDX

               End DoDot:1

 +24       IF $DATA(ACKCDST(1))

               IF $DATA(ACKCDST(30))

                   Begin DoDot:1

 +25                   SET ACKI=""

                       SET CNTR9=0

                       SET CNTR0=0

 +26                   FOR

                           SET ACKI=$ORDER(ACKICD(ACKI))

                           if ACKI=""

                               QUIT

                           Begin DoDot:2

 +27                           SET ACKICD=""

 +28                           FOR

                                   SET ACKICD=$ORDER(ACKICD(ACKI,ACKICD))

                                   if ACKICD=""

                                       QUIT

                                   Begin DoDot:3

 +29                                   SET ACKDX=$PIECE(ACKICD(ACKI,ACKICD),U)

 +30                                   SET ACKDESC=$PIECE(ACKICD(ACKI,ACKICD),U,3)

 +31                                   SET ACKDATE=$$NUMDT^ACKQUTL($PIECE(ACKICD(ACKI,ACKICD),U,4))

 +32                                   IF ACKICD=1

                                           SET CNTR9=CNTR9+1

                                           SET ACKICD9(CNTR9)=ACKDX_U_ACKDESC_U_ACKDATE

 +33                                   IF ACKICD=30

                                           SET CNTR0=CNTR0+1

                                           SET ACKICD0(CNTR0)=ACKDX_U_ACKDESC_U_ACKDATE

                                   End DoDot:3

                           End DoDot:2

 +34                   DO PRTHEAD

                       DO EXIT

                       QUIT

                   End DoDot:1

 +35       SET ACKI=""

FOR

               SET ACKI=$ORDER(ACKICD(ACKI))

               if ACKI=""

                   QUIT

               if $Y>(IOSL-5)

                   DO WAIT

               if $DATA(DIRUT)

                   QUIT

               Begin DoDot:1

 +36               SET ACKICDX=""

 +37               SET ACKICDX=$ORDER(ACKICD(ACKI,ACKICDX))

                   Begin DoDot:2

 +38                   WRITE !,$PIECE(ACKICD(ACKI,ACKICDX),U),?10,$PIECE(ACKICD(ACKI,ACKICDX),U,3),?72,$$NUMDT^ACKQUTL($PIECE(ACKICD(ACKI,ACKICDX),U,4))

                   End DoDot:2

               End DoDot:1

EXIT      ;

 +1       ;  Quit flag for template

           IF $GET(DIRUT)=1

               SET ACKDIRUT=1

 +2        WRITE !!

 +3        KILL %ZIS,ACK,ACKCDST,ACKDC,ACKDD,ACKDESC,ACKDFN,ACKDN,ACKDX,ACKI,ACKICD,ACKINP,ACKIVD,ACKLINE

 +4        KILL ACKRD,ACKDATE,ACKICD0,ACKICD9,ACKICDX,ACKINFO

 +5        KILL CNTR0,CNTR9,DATA,DIRUT,DTOUT,DUOUT,VA,VADM,VAEL,VAERR,VAIN,X,X1,Y,ZTDESC,ZTIO

 +6        KILL ZTRTN,ZTSAVE

 +7        if $EXTRACT(IOST)'="C"

               WRITE @IOF

           DO ^%ZISC

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +8        QUIT

 +9       ;

WAIT      ;

 +1        KILL DIRUT

           IF $EXTRACT(IOST)'="C"

               WRITE @IOF

               QUIT

 +2        SET DIR(0)="E"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT

           WRITE @IOF,"Patient Diagnostic History (Cont'd)","  (",ACK(1),")"

           DO DIHEAD

 +3        QUIT

DIHEAD    ;

 +1        WRITE ?72,"DATE"

 +2        WRITE !,"DIAGNOSIS",?72,"ENTERED"

           SET ACKLINE=""

           SET $PIECE(ACKLINE,"-",IOM)=""

           WRITE !,ACKLINE

 +3        QUIT

ICDSORT   ;

 +1        SET ACKI=0

FOR

               SET ACKI=$ORDER(^ACK(509850.2,DFN,1,ACKI))

               if 'ACKI

                   QUIT

               Begin DoDot:1

 +2                SET ACKDC=^ACK(509850.2,DFN,1,ACKI,0)

                   SET ACKDD=$PIECE(ACKDC,U,2)

 +3       ; returns 1 for ICD9 and 30 for ICD10

                   SET ACKICD=$$CSI^ICDEX(80,+ACKDC)

 +4                SET ACKINFO=$$ICDDATA^ICDXCODE(ACKICD,+ACKDC,ACKDD,"I")

 +5                SET ACKTGT=$PIECE(ACKINFO,U,3)

 +6                SET ACKDN=$PIECE(ACKINFO,U,2)

 +7                SET ACKICD(ACKDN,ACKICD)=ACKDN_U_ACKTGT_U_$$DIAGTXT^ACKQUTL8(+ACKDC,ACKDD)_U_ACKDD

               End DoDot:1

 +8        KILL ACKTGT,ACKMSG

 +9        QUIT

 +10      ;

TPLTE     ;  Display Visit Clinic and Division

 +1        NEW ACKTMPE

 +2        WRITE !!,"CLINIC: ",$$GET1^DIQ(509850.6,ACKVIEN,"2.6")

 +3        WRITE ?45,"DIVISION: ",$$GET1^DIQ(509850.6,ACKVIEN,60),!

 +4       ;  Display more Patient data

 +5        WRITE "PATIENT: ",ACK(1),?45,"DOB: ",ACK(2),?63,"SSN: ",ACK(3)

 +6       ;  If no Visit Eligibility on visit file display Primary Elig.

 +7        SET ACKTMPE=$$GET1^DIQ(509850.6,ACKVIEN_",",80,"E")

 +8        IF ACKTMPE

               Begin DoDot:1

 +9                WRITE !,"VISIT ELIGIBILITY: "_ACKTMPE

               End DoDot:1

 +10      ;

 +11       IF 'ACKTMPE

               Begin DoDot:1

 +12               WRITE !,"ELIGIBILITY: ",ACK(9)

               End DoDot:1

 +13       WRITE ?45,"INITIAL VISIT DATE: ",ACKIVD

 +14       if $LENGTH(ACK(4))

               WRITE !,ACK(4)

           WRITE !,ACK(5)

           if ACKINP

               DO INP

 +15      ;  D VISIT

 +16      ;

 +17       QUIT

 +18      ;

VISIT     ;  Displays Service connected data

 +1       ;

 +2       ;  If Patient not service connected QUIT

           IF 'ACKSC

               QUIT

 +3       ;  If system not set up for PCE then QUIT

           IF 'ACKPCE

               QUIT

 +4       ;

 +5        NEW ACKX,ACKVV,ACKPP,ACKVSC,ACKAAO,ACKEENV,ACKRRAD,ACK,ACKSTR

 +6       ;

 +7        DO GETDATA

 +8        IF ACKVISIT="NEW"

               IF $GET(ACKPCENO)=""

                   DO UNKNOWN

                   QUIT

 +9        IF 'ACKVSC

               DO NOT("This Visit's Treatment :",ACKAAO,ACKRRAD,ACKEENV)

               QUIT

 +10       IF ACKVSC

               DO CONNECT

 +11       QUIT

 +12      ;

 +13      ;

GETDATA   ;  Get visit data

 +1       ;

 +2        KILL ACK

 +3        DO GETS^DIQ(509850.6,ACKVIEN,"20;25;30;35","I","ACK")

 +4        SET ACKVSC=ACK(509850.6,ACKVIEN_",",20,"I")

 +5        SET ACKAAO=ACK(509850.6,ACKVIEN_",",25,"I")

 +6        SET ACKEENV=ACK(509850.6,ACKVIEN_",",35,"I")

 +7        SET ACKRRAD=ACK(509850.6,ACKVIEN_",",30,"I")

 +8        KILL ACK

 +9        QUIT

 +10      ;

CONNECT    WRITE !!,"This visit's Treatment is Service Connected.",!

 +1        QUIT

 +2       ;

NOT(ACKSTR,ACKAAO,ACKRRAD,ACKEENV) ;

 +1        WRITE !!,ACKSTR,!

 +2        WRITE "------------------------------------------------------------------------------"

 +3       ;

 +4        WRITE !,"Related to AGENT ORANGE ? : "_$SELECT(ACKAAO="1":"YES",1:"NO")

           WRITE ?50,"Service Connected ? : NO"

 +5       ;

 +6        WRITE !,"Related to RADIATION EXPOSURE ? : "_$SELECT(ACKRRAD="1":"YES",1:"NO")

 +7       ;

 +8        WRITE !,"Related to ENVIRONMENTAL CONTAMINANTS ? : "_$SELECT(ACKEENV="1":"YES",1:"NO")

 +9        QUIT

 +10      ;

UNKNOWN    NEW ACKPASS

 +1        SET ACKPASS=0

 +2        WRITE !!,"This visit's Treatment:",!

 +3        WRITE "------------------------------------------------------------------------------",!

 +4        IF ACKAO

               WRITE "Related to AGENT ORANGE ? : UNKNOWN"

               if 'ACKPASS

                   DO SERV

 +5        IF ACKRAD

               WRITE !,"Related to RADIATION EXPOSURE ? : UNKNOWN"

               if 'ACKPASS

                   DO SERV

 +6        IF ACKENV

               WRITE !,"Related to ENVIRONMENTAL CONTAMINANTS ? : UNKNOWN"

               if 'ACKPASS

                   DO SERV

 +7        if 'ACKPASS

               DO SERV

 +8        WRITE !

 +9        QUIT

 +10      ;

SERV      ;

 +1        WRITE ?50,"Service Connected ? : UNKNOWN"

           SET ACKPASS=1

 +2        QUIT

 +3       ;

ERROR     ; Display error message if registration returns error that indicates

 +1       ; that the Appointment Management database is not available.

 +2       ;

 +3        NEW ACKERR

 +4        WRITE !!!!,"   ** The Appointment Management Data Base is unavailable. **"

 +5        WRITE !!,"   ** Please report this problem to IRM as soon as possible. **",!!!

 +6        WRITE "   Press any key to continue."

 +7        READ ACKERR:DTIME

 +8       ;

 +9        QUIT

 +10      ;

PRTHEAD   ;

 +1        SET CNTR9=0

           SET CNTR0=0

 +2        WRITE !,"ICD-9-CM",!

 +3        FOR CNTR9=1:1

               SET DATA=$GET(ACKICD9(CNTR9))

               if '$DATA(ACKICD9(CNTR9))

                   QUIT

               Begin DoDot:1

 +4                SET ACKDX=$PIECE(DATA,U)

 +5                SET ACKDESC=$PIECE(DATA,U,2)

 +6                SET ACKDATE=$PIECE(DATA,U,3)

 +7                KILL ACKICDDS,ACKARNUM

                   SET ACKICDDS=ACKDESC

                   DO BRKDESC^ACKQR3(57)

 +8       ;W !,ACKDX,?10,ACKDESC,?72,ACKDATE

 +9                WRITE !,ACKDX,?10,ACKICDDS(1),?71,ACKDATE

 +10               FOR ACKARNM2=2:1:ACKARNUM

                       WRITE !?10,ACKICDDS(ACKARNM2)

 +11               KILL ACKICDDS,ACKARNUM,ACKARNM2

               End DoDot:1

 +12       WRITE !!,"ICD-10-CM",!

 +13       FOR CNTR0=1:1

               SET DATA=$GET(ACKICD0(CNTR0))

               if '$DATA(ACKICD0(CNTR0))

                   QUIT

               Begin DoDot:1

 +14               SET ACKDX=$PIECE(DATA,U)

 +15               SET ACKDESC=$PIECE(DATA,U,2)

 +16               SET ACKDATE=$PIECE(DATA,U,3)

 +17               KILL ACKICDDS,ACKARNUM

                   SET ACKICDDS=ACKDESC

                   DO BRKDESC^ACKQR3(57)

 +18      ;W !,ACKDX,?10,ACKDESC,?72,ACKDATE

 +19               WRITE !,ACKDX,?10,ACKICDDS(1),?71,ACKDATE

 +20               FOR ACKARNM2=2:1:ACKARNUM

                       WRITE !?10,ACKICDDS(ACKARNM2)

 +21               KILL ACKICDDS,ACKARNUM,ACKARNM2

               End DoDot:1

 +22       QUIT

 +23      ;

ACKQUTL7.m