APCLNJ2.m

APCLNJ2 ; IHS/CMI/LAB - E-CODE CLINIC VISITS BY DATE RANGE/BY AGE/VISIT TYPE ;

 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 ;This report is to be used to list Injury visits by clinic/by age

 ;

 W:$D(IOF) @IOF W !!?21,"INJURY SURVEILLANCE SUMMARY REPORT"

 W !,?27,"(EXTERNAL CAUSE CODES)",!

 W !!,"This report will COUNT visits which have an injury diagnosis.  The user",!,"can select which visits to count based on any of the following criteria:",!

 W ?15,"- Visit date",!?15,"- Clinic of Visit",!?15,"- Service Category of Visit",!?15,"- Type of Visit",!?15,"- Location of Encounter",!?15,"- Age Range",!

 W !,"The visit counts are summarized by the following 18 External Cause Categories:",!!,?2,"Motor Vehicles..Boat/Water..Air Transport..Accidental Poison..Environmental..",!

 W ?2,"Stings/Venons..Falls..Fire/Flame..Animal Vites..Drowning/Sub..Cutting/Piercing",!

 W ?2,"Fire Arms..Sports Injury..Suicide..Assault..Child Abuse..Undetermined..Other..",!

 W !,?2,"**Detailed information for each Cause of Injury Code Range is outlined in the User Manual**",!!

GETDATES ;

BD ;get beginning date

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

 I $D(DIRUT) G XIT

 S APCLBD=Y

ED ;get ending date

 W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit 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

 ;

 ;

LOC ;

 K APCLLOC,APCLLOCT

 W ! S DIR(0)="YO",DIR("A")="Include visits from ALL Locations",DIR("B")="Yes"

 S DIR("?")="If you wish to include visits from ALL locations answer Yes.  If you wish to list visits for only one location of encounter enter NO."

 D ^DIR K DIR

 G:$D(DIRUT) BD

 I Y=1 G TYPE

LOC1 ;enter location

 S X="LOCATION OF ENCOUNTER",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 XIT

 D PEP^AMQQGTX0(+Y,"APCLLOCT(")

 I '$D(APCLLOCT) G LOC

 I $D(APCLLOCT("*")) K APCLLOCT

TYPE ;

 K APCLTYP,APCLTYPT

 W ! S DIR(0)="YO",DIR("A")="Include ALL Visit Types",DIR("B")="Yes"

 S DIR("?")="If you wish to include all Visit Types (IHS,CONTRACT,638,etc) answer Yes.  If you wish to list visits for only one visit type enter NO."

 D ^DIR K DIR

 G:$D(DIRUT) LOC

 I Y=1 G SC

TYPE1 ;

 S X="VISIT TYPE",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 XIT

 D PEP^AMQQGTX0(+Y,"APCLTYPT(")

 I '$D(APCLTYPT) G TYPE

 I $D(APCLTYPT("*")) K APCLTYPT

SC ;

 K APCLSCT

 K APCLSC,APCLSCT W ! S DIR(0)="YO",DIR("A")="Include ALL Visit Service Categories",DIR("B")="Yes"

 S DIR("?")="If you wish to include all visit service categories (Ambulatory,Hospitalization,etc) answer Yes.  If you wish to list visits for only one service category enter NO." D ^DIR K DIR

 G:$D(DIRUT) BD

 I Y=1 G CLINIC

SC1 ;enter sc

 S X="SERVICE CATEGORY",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 XIT

 D PEP^AMQQGTX0(+Y,"APCLSCT(")

 I '$D(APCLSCT) G SC

 I $D(APCLSCT("*")) K APCLSCT

CLINIC ;

 K APCLCLNT

 W ! S DIR(0)="Y",DIR("A")="Include visits to ALL clinics",DIR("B")="Yes" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) SC

 I Y=1 G AGE

CLINIC1 ;

 S X="CLINIC",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 XIT

 D PEP^AMQQGTX0(+Y,"APCLCLNT(")

 I '$D(APCLCLNT) G CLINIC

 I $D(APCLCLNT("*")) K APCLCLNT

AGE ;Age Screening

 K APCLAGE,APCLAGET

 W ! S DIR(0)="YO",DIR("A")="Would you like to restrict the report by Patient age range",DIR("B")="NO"

 S DIR("?")="If you wish to include visits from ALL age ranges, anwser No.  If you wish to list visits for only patients within a particular age range, enter Yes."

 D ^DIR K DIR

 G:$D(DIRUT) CLINIC

 I 'Y G ZIS

 ;

AGER ;Age Screening

 W !

 S DIR(0)="FO^1:7",DIR("A")="Enter an Age Range (e.g. 5-12,1-1)" D ^DIR

 I Y="" W !!,"No age range entered." G AGE

 I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20." G AGER

 S APCLAGET=Y

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G AGE

 S XBRC="^APCLNJ21",XBRP="^APCLNJ22",XBNS="APCL",XBRX="XIT^APCLNJ2"

 D ^XBDBQUE

XIT K Y,APCLBD,APCLED,APCLCL,APCLICD,APCLBICD,APCLEICD,ZTSK,ZTQUEUED,%DT,APCLBT,APCLSD,APCLJOB,APCLPROV,APCLFOUN,APCLDFN,APCLCLNT,APCLLOCT,APCLSCT,APCLTYPT,APCLAGE,APCLAGET

 K APCL65,APCLBD,APCLCLS,APCLED,APCLFPV,APCLFVS,APCLIOM,APCLMCR,DA,DFN,%DT,%T,%Y,APCLAGE,G,POP,AMQQTAX,AMQQTDFN,APCLBDD,APCLEDD,APCLFR,APCLPA,APCLPOV,APCLSC,APCLTYPE

 K APCLNAME,APCLNAR,APCLPRC,APCLPRV,APCLPS,APCLPTOT,APCLPV,APCLSTR

 K APCLSTOP,APCLVDFN,APCLVDT,APCLVPOV,APCLVPRC,APCLVRV,APCLVTOT,Y

 K DIC,DOB,DR,APCLHRCN,I,LKPRINT,SEX,APCLSTR,X,APCLCLX,APCLCL,APCLPGRD

 K AMQQATN,AMQQCOMP,AMQQCTXS,AMQQLINK,AMQQTAX

 K APCLVGRA,APCLPAGE,APCLICD,APCLBICD,APCLEICD,APCLPV,APCLPRC,APCLFLG

 K APCLCIEN,APCLCNTR,APCLET,APCLGOT,APCLGTOT,APCLTAX,APCLTXN,APCLX,APCLY,APCLTEXT,APCLPER,APCLALC,APCLATOT,APCLZ

 Q

APCLNJ2   ; IHS/CMI/LAB - E-CODE CLINIC VISITS BY DATE RANGE/BY AGE/VISIT TYPE ;

 +1       ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58

 +2       ;This report is to be used to list Injury visits by clinic/by age

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

           WRITE !!?21,"INJURY SURVEILLANCE SUMMARY REPORT"

 +5        WRITE !,?27,"(EXTERNAL CAUSE CODES)",!

 +6        WRITE !!,"This report will COUNT visits which have an injury diagnosis.  The user",!,"can select which visits to count based on any of the following criteria:",!

 +7        WRITE ?15,"- Visit date",!?15,"- Clinic of Visit",!?15,"- Service Category of Visit",!?15,"- Type of Visit",!?15,"- Location of Encounter",!?15,"- Age Range",!

 +8        WRITE !,"The visit counts are summarized by the following 18 External Cause Categories:",!!,?2,"Motor Vehicles..Boat/Water..Air Transport..Accidental Poison..Environmental..",!

 +9        WRITE ?2,"Stings/Venons..Falls..Fire/Flame..Animal Vites..Drowning/Sub..Cutting/Piercing",!

 +10       WRITE ?2,"Fire Arms..Sports Injury..Suicide..Assault..Child Abuse..Undetermined..Other..",!

 +11       WRITE !,?2,"**Detailed information for each Cause of Injury Code Range is outlined in the User Manual**",!!

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !

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

           SET DIR("A")="Enter beginning Visit Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET APCLBD=Y

ED        ;get ending date

 +1        WRITE !

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

           SET DIR("A")="Enter ending Visit 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       ;

 +6       ;

LOC       ;

 +1        KILL APCLLOC,APCLLOCT

 +2        WRITE !

           SET DIR(0)="YO"

           SET DIR("A")="Include visits from ALL Locations"

           SET DIR("B")="Yes"

 +3        SET DIR("?")="If you wish to include visits from ALL locations answer Yes.  If you wish to list visits for only one location of encounter enter NO."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO BD

 +6        IF Y=1

               GOTO TYPE

LOC1      ;enter location

 +1        SET X="LOCATION OF ENCOUNTER"

           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 XIT

 +2        DO PEP^AMQQGTX0(+Y,"APCLLOCT(")

 +3        IF '$DATA(APCLLOCT)

               GOTO LOC

 +4        IF $DATA(APCLLOCT("*"))

               KILL APCLLOCT

TYPE      ;

 +1        KILL APCLTYP,APCLTYPT

 +2        WRITE !

           SET DIR(0)="YO"

           SET DIR("A")="Include ALL Visit Types"

           SET DIR("B")="Yes"

 +3        SET DIR("?")="If you wish to include all Visit Types (IHS,CONTRACT,638,etc) answer Yes.  If you wish to list visits for only one visit type enter NO."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO LOC

 +6        IF Y=1

               GOTO SC

TYPE1     ;

 +1        SET X="VISIT TYPE"

           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 XIT

 +2        DO PEP^AMQQGTX0(+Y,"APCLTYPT(")

 +3        IF '$DATA(APCLTYPT)

               GOTO TYPE

 +4        IF $DATA(APCLTYPT("*"))

               KILL APCLTYPT

SC        ;

 +1        KILL APCLSCT

 +2        KILL APCLSC,APCLSCT

           WRITE !

           SET DIR(0)="YO"

           SET DIR("A")="Include ALL Visit Service Categories"

           SET DIR("B")="Yes"

 +3        SET DIR("?")="If you wish to include all visit service categories (Ambulatory,Hospitalization,etc) answer Yes.  If you wish to list visits for only one service category enter NO."

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO BD

 +5        IF Y=1

               GOTO CLINIC

SC1       ;enter sc

 +1        SET X="SERVICE CATEGORY"

           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 XIT

 +2        DO PEP^AMQQGTX0(+Y,"APCLSCT(")

 +3        IF '$DATA(APCLSCT)

               GOTO SC

 +4        IF $DATA(APCLSCT("*"))

               KILL APCLSCT

CLINIC    ;

 +1        KILL APCLCLNT

 +2        WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Include visits to ALL clinics"

           SET DIR("B")="Yes"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO SC

 +4        IF Y=1

               GOTO AGE

CLINIC1   ;

 +1        SET X="CLINIC"

           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 XIT

 +2        DO PEP^AMQQGTX0(+Y,"APCLCLNT(")

 +3        IF '$DATA(APCLCLNT)

               GOTO CLINIC

 +4        IF $DATA(APCLCLNT("*"))

               KILL APCLCLNT

AGE       ;Age Screening

 +1        KILL APCLAGE,APCLAGET

 +2        WRITE !

           SET DIR(0)="YO"

           SET DIR("A")="Would you like to restrict the report by Patient age range"

           SET DIR("B")="NO"

 +3        SET DIR("?")="If you wish to include visits from ALL age ranges, anwser No.  If you wish to list visits for only patients within a particular age range, enter Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO CLINIC

 +6        IF 'Y

               GOTO ZIS

 +7       ;

AGER      ;Age Screening

 +1        WRITE !

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

           SET DIR("A")="Enter an Age Range (e.g. 5-12,1-1)"

           DO ^DIR

 +3        IF Y=""

               WRITE !!,"No age range entered."

               GOTO AGE

 +4        IF Y'?1.3N1"-"1.3N

               WRITE !!,$CHAR(7),$CHAR(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20."

               GOTO AGER

 +5        SET APCLAGET=Y

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO AGE

 +3        SET XBRC="^APCLNJ21"

           SET XBRP="^APCLNJ22"

           SET XBNS="APCL"

           SET XBRX="XIT^APCLNJ2"

 +4        DO ^XBDBQUE

XIT        KILL Y,APCLBD,APCLED,APCLCL,APCLICD,APCLBICD,APCLEICD,ZTSK,ZTQUEUED,%DT,APCLBT,APCLSD,APCLJOB,APCLPROV,APCLFOUN,APCLDFN,APCLCLNT,APCLLOCT,APCLSCT,APCLTYPT,APCLAGE,APCLAGET

 +1        KILL APCL65,APCLBD,APCLCLS,APCLED,APCLFPV,APCLFVS,APCLIOM,APCLMCR,DA,DFN,%DT,%T,%Y,APCLAGE,G,POP,AMQQTAX,AMQQTDFN,APCLBDD,APCLEDD,APCLFR,APCLPA,APCLPOV,APCLSC,APCLTYPE

 +2        KILL APCLNAME,APCLNAR,APCLPRC,APCLPRV,APCLPS,APCLPTOT,APCLPV,APCLSTR

 +3        KILL APCLSTOP,APCLVDFN,APCLVDT,APCLVPOV,APCLVPRC,APCLVRV,APCLVTOT,Y

 +4        KILL DIC,DOB,DR,APCLHRCN,I,LKPRINT,SEX,APCLSTR,X,APCLCLX,APCLCL,APCLPGRD

 +5        KILL AMQQATN,AMQQCOMP,AMQQCTXS,AMQQLINK,AMQQTAX

 +6        KILL APCLVGRA,APCLPAGE,APCLICD,APCLBICD,APCLEICD,APCLPV,APCLPRC,APCLFLG

 +7        KILL APCLCIEN,APCLCNTR,APCLET,APCLGOT,APCLGTOT,APCLTAX,APCLTXN,APCLX,APCLY,APCLTEXT,APCLPER,APCLALC,APCLATOT,APCLZ

 +8        QUIT