- ACKQNQ ;AUG/JLTP,AEM BIR/PTD HCIOFO/BH HCIOFO/AG - Inquire - A&SP Patient ;18 Jun 2013 10:09 AM
- ;;3.0;QUASAR;**8,14,18,22,21**;Feb 11, 2000;Build 40
- ;
- ; Reference/IA
- ; $$CSI^ICDEX - 5747
- ;
- OPTN ; Introduce option.
- S ACKQUIT=0
- W:$E(IOST,1,2)="C-" @IOF,!,"This option displays demographic data, inpatient status, and diagnostic",!,"history for a selected A&SP patient."
- ;
- DIC ; LOOKUP PATIENT
- N DIC
- W ! S DIC=509850.2,DIC(0)="AEMQ" D ^DIC
- I (Y<0)!($D(DUOUT)) S ACKQUIT=1 G EXIT
- S ACKDFN=+Y
- ;
- ASK ; Update patient's diagnostic history?
- S DIR(0)="Y",DIR("A")="Do you want to update this patient's diagnostic history NOW",DIR("B")="NO",DIR("?")="Enter YES to recompile the Problem List; enter NO to continue."
- S DIR("??")="^D UPDATE^ACKQHLP1" W ! D ^DIR K DIR G:$D(DIRUT) EXIT I Y=1 D UPDATE
- ;
- DEV W !!,"The right margin for this report is 80.",!,"You can queue it to run at a later time.",!
- K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
- I $D(IO("Q")) K IO("Q") S ZTRTN="EN^ACKQNQ",ZTSAVE("ACKDFN")="",ZTDESC="QUASAR - Inquire - A&SP Patient" D ^%ZTLOAD D HOME^%ZIS K ZTSK G EXIT
- ;
- EN U IO N DFN,I,X,Y S DFN=ACKDFN
- D DEM^VADPT,INP^VADPT,ELIG^VADPT
- S ACKIVD=$$NUMDT^ACKQUTL($P(^ACK(509850.2,DFN,0),U,2))
- K ACK S ACK(1)=VADM(1),ACK(2)=$P(VADM(3),U,2),ACK(3)=$P(VADM(2),U,2),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:$E(IOST,1,2)="C-" @IOF
- D CNTR^ACKQUTL("Patient Inquiry")
- ;
- W !!
- W "PATIENT: ",ACK(1),?45,"DOB: ",ACK(2),?63,"SSN: ",ACK(3)
- W !,"ELIGIBILITY: ",ACK(9)
- W ?45,"INITIAL VISIT DATE: ",ACKIVD
- W:$L(ACK(4)) !,ACK(4) W !,ACK(5) D:ACKINP INP
- ;
- I $P(VAEL(3),U,1) W !!,"Patient is Service Connected."
- I '$P(VAEL(3),U,1) D
- . S ACKPAT=DFN D STATUS^ACKQUTL4 K VASV
- . D NOT^ACKQUTL7("Patient is not Service Connected.",ACKAO,ACKRAD,ACKENV)
- . K ACKPAT,ACKAO,ACKRAD,ACKENV
- ;
- D RATDIS G:$G(DIRUT) EXIT
- D ICDSORT,DIAGHIST
- ;
- EXIT I $G(ACKVISIT)'="",$G(DIRUT)=1 S ACKDIRUT=1 ; Quit flag for template
- K %ZIS,ACK,ACKCDST,ACKDATE,ACKDC,ACKDD,ACKDESC,ACKDFN,ACKDN,ACKDX
- K ACKI,ACKICD,ACKICDX,ACKINFO,ACKINP,ACKIVD,ACKLINE,ACKQECON,ACKQIR,ACKQORG
- K ACKRD,ACKQSER,CNTR0,CNTR9,DATA,DIRUT,DTOUT,DUOUT,IOUOFF,IOUON,POP
- K VA,VADM,VAEL,VAERR,VAIN,X,X1,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE
- I $G(ACKQUIT)=1 D KILL^%ZISS Q
- I $E(IOST,1,2)="C-" W !!,"Press return to continue." R X:DTIME W @IOF
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- S ACKQUIT=0 G DIC
- Q
- ;
- EN1 ; CALL THIS ENTRY POINT INSTEAD OF EN
- D HOME^%ZIS G EN
- ;
- ;
- INP ; PRINT INPATIENT INFO
- W !,"WARD: ",ACK(6),?20,"ROOM/BED: ",ACK(7),?40,"TREATING SPEC: ",$E(ACK(8),1,25)
- Q
- ;
- ;
- RATDIS ; Display Patients RATED DISABILITIES
- Q:'$O(^DPT(DFN,.372,0))
- N ACKRD,RC,X,X1
- D ENS^%ZISS
- ;---
- S RC=$$PAGE(5) Q:RC<0 W:'RC !!
- W IOUON,"Rated Disabilities",IOUOFF,!
- ;---
- S ACKRD=0
- F S ACKRD=$O(^DPT(DFN,.372,ACKRD)) Q:'ACKRD D Q:RC<0
- . S RC=$$PAGE(2) Q:RC<0
- . W:RC IOUON,"Rated Disabilities (cont'd)",IOUOFF,!
- . S X=^DPT(DFN,.372,ACKRD,0),X1=$P(^DIC(31,+X,0),U)
- . W !,X1_" ("_$P(X,U,2)_"%)" I $P(X,U,3) W " (SC)"
- Q
- ;
- DIAGHIST ;
- Q:$D(ACKICD)<10
- N ACKI,ACKICD0,ACKICD9,RC
- D ENS^%ZISS
- ;---
- S RC=$$PAGE(7) Q:RC<0 W:'RC !!
- W IOUON,"Patient Diagnostic History",IOUOFF
- W !,$S($P(VADM(5),U)="F":"Ms. ",1:"Mr. "),$P(VADM(1),",")," has been seen for the following:",!
- D DIHEAD
- ;---
- S ACKI=""
- S ACKICDX=""
- F S ACKI=$O(ACKICD(ACKI)) Q:ACKI="" D Q:RC<0
- . S RC=$$PAGE(2) Q:RC<0
- . I RC D D DIHEAD
- . . W IOUON,"Patient Diagnostic History (cont'd)"," (",ACK(1),")",IOUOFF,!
- . 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 Q:RC<0
- . S RC=$$PAGE(2) Q:RC<0
- . I RC D D DIHEAD
- . . W IOUON,"Patient Diagnostic History (cont'd)"," (",ACK(1),")",IOUOFF,! Q
- . S ACKICDX=""
- . S ACKICDX=$O(ACKICD(ACKI,ACKICDX)) D
- . . W !,$P(ACKICD(ACKI,ACKICDX),U),?15,$P(ACKICD(ACKI,ACKICDX),U,3),?60,$$NUMDT^ACKQUTL($P(ACKICD(ACKI,ACKICDX),U,4))
- Q
- ;
- CLASDIS ; Display Patient Servive Classifications
- N RC
- I '$D(ACKQSER),'$D(ACKQORG),'$D(ACKQIR),'$D(ACKQECON) Q
- S RC=$$PAGE(5) Q:RC<0 W:'RC !!
- D ENS^%ZISS
- W IOUON,"Service Classifications",IOUOFF,!
- W:$D(ACKQSER) " SERVICE-CONNECTED " W:$D(ACKQORG) " AGENT-ORANGE " W:$D(ACKQIR) " RADIATION " W:$D(ACKQECON) " ENVIRONMENTAL-CONTAMINANTS"
- W !
- Q
- ;
- ;
- DIHEAD W !,"DIAGNOSIS",?60,"DATE ENTERED",!,$$REPEAT^XLFSTR("-",IOM-1)
- 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
- ;
- UPDATE ; Update patient's diagnostic history in 509850.2.
- ; ACKDFN is defined upon entry to this module.
- D WAIT^DICD W !
- D PROBLIST^ACKQUTL3(ACKDFN,1)
- Q
- ;
- ;***** CHECKS IS NEW PAGE SHOULD BE STARTED
- ;
- ; [RESERVE] Number of additional reserved lines (0, by default).
- ; If the current page does not have so many lines
- ; available, a new page will be started.
- ;
- ; [FORCE] Force the prompt
- ;
- ; Return values:
- ;
- ; -2 Timeout
- ; -1 User canceled the output ('^' was entered)
- ; 0 Ok
- ; 1 New page
- ;
- PAGE(RESERVE,FORCE) ;
- N RC
- I ($Y'<($G(IOSL,24)-$G(RESERVE,1)))!$G(FORCE) D S $Y=0
- . I $E(IOST,1,2)'="C-" W @IOF Q
- . N DA,DIR,DIROUT,DTOUT,DUOUT,I,X,Y
- . S DIR(0)="E"
- . D ^DIR
- . S RC=$S($D(DUOUT):-1,$D(DTOUT):-2,1:1)
- . W:RC>0 @IOF
- Q +$G(RC)
- ;
- 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(40)
- . ;W !,ACKDX,?15,ACKDESC,?60,ACKDATE
- . W !,ACKDX,?15,ACKICDDS(1),?60,ACKDATE
- . F ACKARNM2=2:1:ACKARNUM W !?15,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(40)
- . ;W !,ACKDX,?15,ACKDESC,?60,ACKDATE
- . W !,ACKDX,?15,ACKICDDS(1),?60,ACKDATE
- . F ACKARNM2=2:1:ACKARNUM W !?15,ACKICDDS(ACKARNM2)
- . K ACKICDDS,ACKARNUM,ACKARNM2
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQNQ 7359 printed Jan 18, 2025@03:33:29 Page 2
- ACKQNQ ;AUG/JLTP,AEM BIR/PTD HCIOFO/BH HCIOFO/AG - Inquire - A&SP Patient ;18 Jun 2013 10:09 AM
- +1 ;;3.0;QUASAR;**8,14,18,22,21**;Feb 11, 2000;Build 40
- +2 ;
- +3 ; Reference/IA
- +4 ; $$CSI^ICDEX - 5747
- +5 ;
- OPTN ; Introduce option.
- +1 SET ACKQUIT=0
- +2 if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF,!,"This option displays demographic data, inpatient status, and diagnostic",!,"history for a selected A&SP patient."
- +3 ;
- DIC ; LOOKUP PATIENT
- +1 NEW DIC
- +2 WRITE !
- SET DIC=509850.2
- SET DIC(0)="AEMQ"
- DO ^DIC
- +3 IF (Y<0)!($DATA(DUOUT))
- SET ACKQUIT=1
- GOTO EXIT
- +4 SET ACKDFN=+Y
- +5 ;
- ASK ; Update patient's diagnostic history?
- +1 SET DIR(0)="Y"
- SET DIR("A")="Do you want to update this patient's diagnostic history NOW"
- SET DIR("B")="NO"
- SET DIR("?")="Enter YES to recompile the Problem List; enter NO to continue."
- +2 SET DIR("??")="^D UPDATE^ACKQHLP1"
- WRITE !
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- GOTO EXIT
- IF Y=1
- DO UPDATE
- +3 ;
- DEV WRITE !!,"The right margin for this report is 80.",!,"You can queue it to run at a later time.",!
- +1 KILL %ZIS,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED."
- GOTO EXIT
- +2 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="EN^ACKQNQ"
- SET ZTSAVE("ACKDFN")=""
- SET ZTDESC="QUASAR - Inquire - A&SP Patient"
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- GOTO EXIT
- +3 ;
- EN USE IO
- NEW DFN,I,X,Y
- SET DFN=ACKDFN
- +1 DO DEM^VADPT
- DO INP^VADPT
- DO ELIG^VADPT
- +2 SET ACKIVD=$$NUMDT^ACKQUTL($PIECE(^ACK(509850.2,DFN,0),U,2))
- +3 KILL ACK
- SET ACK(1)=VADM(1)
- SET ACK(2)=$PIECE(VADM(3),U,2)
- SET ACK(3)=$PIECE(VADM(2),U,2)
- SET ACK(4)=VADM(7)
- SET ACK(6)=$PIECE(VAIN(4),U,2)
- +4 SET ACKINP=$SELECT($LENGTH(ACK(6)):1,1:0)
- SET ACK(5)="Patient is "_$SELECT(ACKINP:"",1:"not ")_"currently an inpatient."
- +5 SET ACK(7)=VAIN(5)
- SET ACK(8)=$PIECE(VAIN(3),U,2)
- SET ACK(9)=$PIECE(VAEL(1),U,2)
- +6 ;
- +7 ;
- PRINT if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- +1 DO CNTR^ACKQUTL("Patient Inquiry")
- +2 ;
- +3 WRITE !!
- +4 WRITE "PATIENT: ",ACK(1),?45,"DOB: ",ACK(2),?63,"SSN: ",ACK(3)
- +5 WRITE !,"ELIGIBILITY: ",ACK(9)
- +6 WRITE ?45,"INITIAL VISIT DATE: ",ACKIVD
- +7 if $LENGTH(ACK(4))
- WRITE !,ACK(4)
- WRITE !,ACK(5)
- if ACKINP
- DO INP
- +8 ;
- +9 IF $PIECE(VAEL(3),U,1)
- WRITE !!,"Patient is Service Connected."
- +10 IF '$PIECE(VAEL(3),U,1)
- Begin DoDot:1
- +11 SET ACKPAT=DFN
- DO STATUS^ACKQUTL4
- KILL VASV
- +12 DO NOT^ACKQUTL7("Patient is not Service Connected.",ACKAO,ACKRAD,ACKENV)
- +13 KILL ACKPAT,ACKAO,ACKRAD,ACKENV
- End DoDot:1
- +14 ;
- +15 DO RATDIS
- if $GET(DIRUT)
- GOTO EXIT
- +16 DO ICDSORT
- DO DIAGHIST
- +17 ;
- EXIT ; Quit flag for template
- IF $GET(ACKVISIT)'=""
- IF $GET(DIRUT)=1
- SET ACKDIRUT=1
- +1 KILL %ZIS,ACK,ACKCDST,ACKDATE,ACKDC,ACKDD,ACKDESC,ACKDFN,ACKDN,ACKDX
- +2 KILL ACKI,ACKICD,ACKICDX,ACKINFO,ACKINP,ACKIVD,ACKLINE,ACKQECON,ACKQIR,ACKQORG
- +3 KILL ACKRD,ACKQSER,CNTR0,CNTR9,DATA,DIRUT,DTOUT,DUOUT,IOUOFF,IOUON,POP
- +4 KILL VA,VADM,VAEL,VAERR,VAIN,X,X1,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE
- +5 IF $GET(ACKQUIT)=1
- DO KILL^%ZISS
- QUIT
- +6 IF $EXTRACT(IOST,1,2)="C-"
- WRITE !!,"Press return to continue."
- READ X:DTIME
- WRITE @IOF
- +7 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +8 SET ACKQUIT=0
- GOTO DIC
- +9 QUIT
- +10 ;
- EN1 ; CALL THIS ENTRY POINT INSTEAD OF EN
- +1 DO HOME^%ZIS
- GOTO EN
- +2 ;
- +3 ;
- INP ; PRINT INPATIENT INFO
- +1 WRITE !,"WARD: ",ACK(6),?20,"ROOM/BED: ",ACK(7),?40,"TREATING SPEC: ",$EXTRACT(ACK(8),1,25)
- +2 QUIT
- +3 ;
- +4 ;
- RATDIS ; Display Patients RATED DISABILITIES
- +1 if '$ORDER(^DPT(DFN,.372,0))
- QUIT
- +2 NEW ACKRD,RC,X,X1
- +3 DO ENS^%ZISS
- +4 ;---
- +5 SET RC=$$PAGE(5)
- if RC<0
- QUIT
- if 'RC
- WRITE !!
- +6 WRITE IOUON,"Rated Disabilities",IOUOFF,!
- +7 ;---
- +8 SET ACKRD=0
- +9 FOR
- SET ACKRD=$ORDER(^DPT(DFN,.372,ACKRD))
- if 'ACKRD
- QUIT
- Begin DoDot:1
- +10 SET RC=$$PAGE(2)
- if RC<0
- QUIT
- +11 if RC
- WRITE IOUON,"Rated Disabilities (cont'd)",IOUOFF,!
- +12 SET X=^DPT(DFN,.372,ACKRD,0)
- SET X1=$PIECE(^DIC(31,+X,0),U)
- +13 WRITE !,X1_" ("_$PIECE(X,U,2)_"%)"
- IF $PIECE(X,U,3)
- WRITE " (SC)"
- End DoDot:1
- if RC<0
- QUIT
- +14 QUIT
- +15 ;
- DIAGHIST ;
- +1 if $DATA(ACKICD)<10
- QUIT
- +2 NEW ACKI,ACKICD0,ACKICD9,RC
- +3 DO ENS^%ZISS
- +4 ;---
- +5 SET RC=$$PAGE(7)
- if RC<0
- QUIT
- if 'RC
- WRITE !!
- +6 WRITE IOUON,"Patient Diagnostic History",IOUOFF
- +7 WRITE !,$SELECT($PIECE(VADM(5),U)="F":"Ms. ",1:"Mr. "),$PIECE(VADM(1),",")," has been seen for the following:",!
- +8 DO DIHEAD
- +9 ;---
- +10 SET ACKI=""
- +11 SET ACKICDX=""
- +12 FOR
- SET ACKI=$ORDER(ACKICD(ACKI))
- if ACKI=""
- QUIT
- Begin DoDot:1
- +13 SET RC=$$PAGE(2)
- if RC<0
- QUIT
- +14 IF RC
- Begin DoDot:2
- +15 WRITE IOUON,"Patient Diagnostic History (cont'd)"," (",ACK(1),")",IOUOFF,!
- End DoDot:2
- DO DIHEAD
- +16 SET ACKICDX=""
- +17 SET ACKICDX=$ORDER(ACKICD(ACKI,ACKICDX))
- +18 SET ACKCDST(ACKICDX)=ACKICDX
- End DoDot:1
- if RC<0
- QUIT
- +19 IF $DATA(ACKCDST(1))
- IF $DATA(ACKCDST(30))
- Begin DoDot:1
- +20 SET ACKI=""
- SET CNTR9=0
- SET CNTR0=0
- +21 FOR
- SET ACKI=$ORDER(ACKICD(ACKI))
- if ACKI=""
- QUIT
- Begin DoDot:2
- +22 SET ACKICD=""
- +23 FOR
- SET ACKICD=$ORDER(ACKICD(ACKI,ACKICD))
- if ACKICD=""
- QUIT
- Begin DoDot:3
- +24 SET ACKDX=$PIECE(ACKICD(ACKI,ACKICD),U)
- +25 SET ACKDESC=$PIECE(ACKICD(ACKI,ACKICD),U,3)
- +26 SET ACKDATE=$$NUMDT^ACKQUTL($PIECE(ACKICD(ACKI,ACKICD),U,4))
- +27 IF ACKICD=1
- SET CNTR9=CNTR9+1
- SET ACKICD9(CNTR9)=ACKDX_U_ACKDESC_U_ACKDATE
- +28 IF ACKICD=30
- SET CNTR0=CNTR0+1
- SET ACKICD0(CNTR0)=ACKDX_U_ACKDESC_U_ACKDATE
- End DoDot:3
- End DoDot:2
- +29 DO PRTHEAD
- DO EXIT
- QUIT
- End DoDot:1
- +30 SET ACKI=""
- FOR
- SET ACKI=$ORDER(ACKICD(ACKI))
- if ACKI=""
- QUIT
- Begin DoDot:1
- +31 SET RC=$$PAGE(2)
- if RC<0
- QUIT
- +32 IF RC
- Begin DoDot:2
- +33 WRITE IOUON,"Patient Diagnostic History (cont'd)"," (",ACK(1),")",IOUOFF,!
- QUIT
- End DoDot:2
- DO DIHEAD
- +34 SET ACKICDX=""
- +35 SET ACKICDX=$ORDER(ACKICD(ACKI,ACKICDX))
- Begin DoDot:2
- +36 WRITE !,$PIECE(ACKICD(ACKI,ACKICDX),U),?15,$PIECE(ACKICD(ACKI,ACKICDX),U,3),?60,$$NUMDT^ACKQUTL($PIECE(ACKICD(ACKI,ACKICDX),U,4))
- End DoDot:2
- End DoDot:1
- if RC<0
- QUIT
- +37 QUIT
- +38 ;
- CLASDIS ; Display Patient Servive Classifications
- +1 NEW RC
- +2 IF '$DATA(ACKQSER)
- IF '$DATA(ACKQORG)
- IF '$DATA(ACKQIR)
- IF '$DATA(ACKQECON)
- QUIT
- +3 SET RC=$$PAGE(5)
- if RC<0
- QUIT
- if 'RC
- WRITE !!
- +4 DO ENS^%ZISS
- +5 WRITE IOUON,"Service Classifications",IOUOFF,!
- +6 if $DATA(ACKQSER)
- WRITE " SERVICE-CONNECTED "
- if $DATA(ACKQORG)
- WRITE " AGENT-ORANGE "
- if $DATA(ACKQIR)
- WRITE " RADIATION "
- if $DATA(ACKQECON)
- WRITE " ENVIRONMENTAL-CONTAMINANTS"
- +7 WRITE !
- +8 QUIT
- +9 ;
- +10 ;
- DIHEAD WRITE !,"DIAGNOSIS",?60,"DATE ENTERED",!,$$REPEAT^XLFSTR("-",IOM-1)
- +1 QUIT
- +2 ;
- +3 ;
- 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 ;
- UPDATE ; Update patient's diagnostic history in 509850.2.
- +1 ; ACKDFN is defined upon entry to this module.
- +2 DO WAIT^DICD
- WRITE !
- +3 DO PROBLIST^ACKQUTL3(ACKDFN,1)
- +4 QUIT
- +5 ;
- +6 ;***** CHECKS IS NEW PAGE SHOULD BE STARTED
- +7 ;
- +8 ; [RESERVE] Number of additional reserved lines (0, by default).
- +9 ; If the current page does not have so many lines
- +10 ; available, a new page will be started.
- +11 ;
- +12 ; [FORCE] Force the prompt
- +13 ;
- +14 ; Return values:
- +15 ;
- +16 ; -2 Timeout
- +17 ; -1 User canceled the output ('^' was entered)
- +18 ; 0 Ok
- +19 ; 1 New page
- +20 ;
- PAGE(RESERVE,FORCE) ;
- +1 NEW RC
- +2 IF ($Y'<($GET(IOSL,24)-$GET(RESERVE,1)))!$GET(FORCE)
- Begin DoDot:1
- +3 IF $EXTRACT(IOST,1,2)'="C-"
- WRITE @IOF
- QUIT
- +4 NEW DA,DIR,DIROUT,DTOUT,DUOUT,I,X,Y
- +5 SET DIR(0)="E"
- +6 DO ^DIR
- +7 SET RC=$SELECT($DATA(DUOUT):-1,$DATA(DTOUT):-2,1:1)
- +8 if RC>0
- WRITE @IOF
- End DoDot:1
- SET $Y=0
- +9 QUIT +$GET(RC)
- +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(40)
- +8 ;W !,ACKDX,?15,ACKDESC,?60,ACKDATE
- +9 WRITE !,ACKDX,?15,ACKICDDS(1),?60,ACKDATE
- +10 FOR ACKARNM2=2:1:ACKARNUM
- WRITE !?15,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(40)
- +18 ;W !,ACKDX,?15,ACKDESC,?60,ACKDATE
- +19 WRITE !,ACKDX,?15,ACKICDDS(1),?60,ACKDATE
- +20 FOR ACKARNM2=2:1:ACKARNUM
- WRITE !?15,ACKICDDS(ACKARNM2)
- +21 KILL ACKICDDS,ACKARNUM,ACKARNM2
- End DoDot:1
- +22 QUIT
- +23 ;