APCLYV5.m

APCLYV5 ; IHS/CMI/LAB - INPATIENT VISITS WITH ICD CODES ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;This report is to be used to list inpatient visits by code

 ;

 W:$D(IOF) @IOF W !!?22,"LISTING OF INPATIENT VISITS WITH ICD CODES"

 W !?30,"SORTED BY HEALTH RECORD NUMBER",!

 S APCLJOB=$J,APCLBTH=$H

F ;

 S DIC("A")="Run for which Facility of Encounter: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 END

 S APCLLOC=+Y

TDATE ;GET TYPE OF DATE

 K DIR S DIR(0)="SB^A:ADMISSION DATE;D:DISCHARGE DATE",DIR("A")="Report Admissions by ADMISSION DATE or DISCHARGE DATE?",DIR("B")="D" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) F

 S APCLSRT=Y,APCLX=Y(0),APCLTITL=$P(APCLX," ")_"S"

GETDATES ;

BD ;get beginning date

 K DIR W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning "_APCLX D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G END

 S APCLBD=Y

ED ;get ending date

 K DIR W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending "_APCLX_" Date:  " S Y=APCLBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S APCLED=Y

 S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X

 ;

SRV ;

 K DIR S DIR(0)="YO",DIR("A")="Do you want ALL Treating Specialties",DIR("B")="YES" D ^DIR G BD:$D(DIRUT) I Y=1 S APCLSV=0 G ICD

 K DIR S DIR(0)="PO^45.7:EMQZ" D ^DIR G SRV:$D(DIRUT) S APCLSV=+Y

ICD ;

 ;IHS/CMI/LAB - change line below to say diagnosis

 K DIR S DIR(0)="S^1:Print all Visits;2:Print Visits for Diagnosis Code Range ;3:Print Visits for Procedure Code Range;4:Print Visits for Provider(s)",DIR("A")="Which visits should be printed" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) SRV

 S APCLICD=Y

 I APCLICD=1 G ZIS

LKUP ;

 S X=$S(APCLICD=2:"DIAGNOSIS",APCLICD=3:"PROCEDURE (MEDICAL)",1:"PROVIDER"),DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G END

 D PEP^AMQQGTX0(+Y,"^XTMP(""APCLYV5"",APCLJOB,APCLBTH,""ICD"",")

 I '$D(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD")) G SRV

 I $D(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD","*")) S APCLICD=1

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G LKUP

 S XBRC="^APCLYV51",XBRP="^APCLYV52",XBNS="APCL",XBRX="END^APCLYV5",XBNS("^XTMP(""APCLYV5"",APCLJOB,APCLBTH,")=""

 D ^XBDBQUE

END K %DT,%T,%Y,ZTSK,Y,POP,APCLBD,APCLED,APCLICD,APCLBICD,APCLEICD,IO("Q"),APCLBTH,APCLAC,APCLJOB,APCLSD,APCLSRT,APCLSTR1,APCLSV,APCLX,APCLSTR,APCLTITL,APCLLENG,APCLHRCN,APCLBT,APCLPROV

 K AMQQATN,AMQQCOMP,AMQQTXS,AMQQUNK,AMQQTAX,AMQQLINK,AMQQCTXS

 Q

APCLYV5   ; IHS/CMI/LAB - INPATIENT VISITS WITH ICD CODES ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;This report is to be used to list inpatient visits by code

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

           WRITE !!?22,"LISTING OF INPATIENT VISITS WITH ICD CODES"

 +5        WRITE !?30,"SORTED BY HEALTH RECORD NUMBER",!

 +6        SET APCLJOB=$JOB

           SET APCLBTH=$HOROLOG

F         ;

 +1        SET DIC("A")="Run for which Facility of Encounter: "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF Y<0

               GOTO END

 +2        SET APCLLOC=+Y

TDATE     ;GET TYPE OF DATE

 +1        KILL DIR

           SET DIR(0)="SB^A:ADMISSION DATE;D:DISCHARGE DATE"

           SET DIR("A")="Report Admissions by ADMISSION DATE or DISCHARGE DATE?"

           SET DIR("B")="D"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO F

 +3        SET APCLSRT=Y

           SET APCLX=Y(0)

           SET APCLTITL=$PIECE(APCLX," ")_"S"

GETDATES  ;

BD        ;get beginning date

 +1        KILL DIR

           WRITE !

           SET DIR(0)="D^:DT:EP"

           SET DIR("A")="Enter beginning "_APCLX

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO END

 +3        SET APCLBD=Y

ED        ;get ending date

 +1        KILL DIR

           WRITE !

           SET DIR(0)="DA^"_APCLBD_":DT:EP"

           SET DIR("A")="Enter ending "_APCLX_" Date:  "

           SET Y=APCLBD

           DO DD^%DT

           SET Y=""

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET APCLED=Y

 +4        SET X1=APCLBD

           SET X2=-1

           DO C^%DTC

           SET APCLSD=X

 +5       ;

SRV       ;

 +1        KILL DIR

           SET DIR(0)="YO"

           SET DIR("A")="Do you want ALL Treating Specialties"

           SET DIR("B")="YES"

           DO ^DIR

           IF $DATA(DIRUT)

               GOTO BD

           IF Y=1

               SET APCLSV=0

               GOTO ICD

 +2        KILL DIR

           SET DIR(0)="PO^45.7:EMQZ"

           DO ^DIR

           IF $DATA(DIRUT)

               GOTO SRV

           SET APCLSV=+Y

ICD       ;

 +1       ;IHS/CMI/LAB - change line below to say diagnosis

 +2        KILL DIR

           SET DIR(0)="S^1:Print all Visits;2:Print Visits for Diagnosis Code Range ;3:Print Visits for Procedure Code Range;4:Print Visits for Provider(s)"

           SET DIR("A")="Which visits should be printed"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO SRV

 +4        SET APCLICD=Y

 +5        IF APCLICD=1

               GOTO ZIS

LKUP      ;

 +1        SET X=$SELECT(APCLICD=2:"DIAGNOSIS",APCLICD=3:"PROCEDURE (MEDICAL)",1:"PROVIDER")

           SET DIC="^AMQQ(5,"

           SET DIC(0)="FM"

           SET DIC("S")="I $P(^(0),U,14)"

           DO ^DIC

           KILL DIC,DA

           IF Y=-1

               WRITE "OOPS - QMAN NOT CURRENT - QUITTING"

               GOTO END

 +2        DO PEP^AMQQGTX0(+Y,"^XTMP(""APCLYV5"",APCLJOB,APCLBTH,""ICD"",")

 +3        IF '$DATA(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD"))

               GOTO SRV

 +4        IF $DATA(^XTMP("APCLYV5",APCLJOB,APCLBTH,"ICD","*"))

               SET APCLICD=1

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO LKUP

 +3        SET XBRC="^APCLYV51"

           SET XBRP="^APCLYV52"

           SET XBNS="APCL"

           SET XBRX="END^APCLYV5"

           SET XBNS("^XTMP(""APCLYV5"",APCLJOB,APCLBTH,")=""

 +4        DO ^XBDBQUE

END        KILL %DT,%T,%Y,ZTSK,Y,POP,APCLBD,APCLED,APCLICD,APCLBICD,APCLEICD,IO("Q"),APCLBTH,APCLAC,APCLJOB,APCLSD,APCLSRT,APCLSTR1,APCLSV,APCLX,APCLSTR,APCLTITL,APCLLENG,APCLHRCN,APCLBT,APCLPROV

 +1        KILL AMQQATN,AMQQCOMP,AMQQTXS,AMQQUNK,AMQQTAX,AMQQLINK,AMQQCTXS

 +2        QUIT