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)
Q
;
;
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="@"
Q
;
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
Q
DIHEAD ;
W ?72,"DATE"
W !,"DIAGNOSIS",?72,"ENTERED" S ACKLINE="",$P(ACKLINE,"-",IOM)="" W !,ACKLINE
Q
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
Q
;
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
;
Q
;
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
Q
;
;
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
Q
;
CONNECT W !!,"This visit's Treatment is Service Connected.",!
Q
;
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")
Q
;
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 !
Q
;
SERV ;
W ?50,"Service Connected ? : UNKNOWN" S ACKPASS=1
Q
;
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
;
Q
;
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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQUTL7 6866 printed Apr 09, 2024@21:34:10 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 ;
