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
