- APCLAP5 ; IHS/CMI/LAB - APC visit counts by selected vars ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- START ;
- I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
- S APCLSITE=DUZ(2)
- S APCLJOB=$J,APCLBTH=$H
- D INFORM
- ;
- 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
- ;
- CL ;choose to tally by clinic or location
- K APCLLOC,APCLLOCT,APCLCLNT,APCLCLOC
- S DIR(0)="S^C:CLINIC;F:FACILITY (LOCATION)",DIR("A")="Do you wish to tally by",DIR("B")="C" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- G:$D(DIRUT) BD
- S APCLCLOC=Y,APCLCLOC("NAME")=Y(0)
- G:APCLCLOC="F" F
- CLINIC ;
- K APCLCLNT
- 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 CL
- S C=0,X=0 F S X=$O(APCLCLNT(X)) Q:X'=+X S C=C+1
- I C>12 W !,$C(7),$C(7),"I can't fit ",C," clinics on this report, please select 1-12 clinics." G CLINIC
- LOC ;get location
- S APCLLOC=$$GETLOC^APCLOCCK
- I APCLLOC=-1 G BD
- G ZIS
- F ;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 CL
- S C=0,X=0 F S X=$O(APCLLOCT(X)) Q:X'=+X S C=C+1
- I C>12 W !,$C(7),$C(7),"I can't fit ",C," facilities on this report, please select 1-12 facilities." G F
- ZIS ;call to XBDBQUE
- DEMO ;
- D DEMOCHK^APCLUTL(.APCLDEMO)
- I APCLDEMO=-1 G LOC
- S XBRP="^APCLAP5P",XBRC="^APCLAP51",XBRX="XIT^APCLAP5",XBNS="APCL"
- D ^XBDBQUE
- D XIT
- Q
- XIT ;
- K APCL1,APCL2,APCLAP,APCLBD,APCLBDD,APCLBT,APCLBTH,APCLCLNT,APCLCLOC,APCLDISC,APCLDT,APCLED,APCLEDD,APCLET,APCLJOB,APCLL,APCLLENG,APCLLOC,APCLLOCT,APCLODAT,APCLPG
- K APCLPRIM,APCLQUIT,APCLSD,APCLSITE,APCLSKIP,APCLSORT,APCLVD,APCLVDFN,APCLVREC,APCLX,APCLY
- K IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,DA,D0,DR,DIC,DIE,C,DIR,DIRUT,DR,%DT,DTOUT,DUOUT,J,X,X1,X2
- Q
- INFORM ;
- W:$D(IOF) @IOF
- W !!,"This report will tally the number of visits by primary care providers, by date",!,"at the locations or to the clinics that you specify. ",!
- W "A total number of 6 locations or clinics will fit on an 80 column report,",!,"you may specify up to 12 if you print the report with 132 columns."
- Q
- ;
- APCLAP5 ; IHS/CMI/LAB - APC visit counts by selected vars ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- START ;
- +1 IF '$GET(DUZ(2))
- WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
- QUIT
- +2 SET APCLSITE=DUZ(2)
- +3 SET APCLJOB=$JOB
- SET APCLBTH=$HOROLOG
- +4 DO INFORM
- +5 ;
- 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 ;
- CL ;choose to tally by clinic or location
- +1 KILL APCLLOC,APCLLOCT,APCLCLNT,APCLCLOC
- +2 SET DIR(0)="S^C:CLINIC;F:FACILITY (LOCATION)"
- SET DIR("A")="Do you wish to tally by"
- SET DIR("B")="C"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- GOTO BD
- +4 SET APCLCLOC=Y
- SET APCLCLOC("NAME")=Y(0)
- +5 IF APCLCLOC="F"
- GOTO F
- CLINIC ;
- +1 KILL APCLCLNT
- +2 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
- +3 DO PEP^AMQQGTX0(+Y,"APCLCLNT(")
- +4 IF '$DATA(APCLCLNT)
- GOTO CL
- +5 SET C=0
- SET X=0
- FOR
- SET X=$ORDER(APCLCLNT(X))
- IF X'=+X
- QUIT
- SET C=C+1
- +6 IF C>12
- WRITE !,$CHAR(7),$CHAR(7),"I can't fit ",C," clinics on this report, please select 1-12 clinics."
- GOTO CLINIC
- LOC ;get location
- +1 SET APCLLOC=$$GETLOC^APCLOCCK
- +2 IF APCLLOC=-1
- GOTO BD
- +3 GOTO ZIS
- F ;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 CL
- +4 SET C=0
- SET X=0
- FOR
- SET X=$ORDER(APCLLOCT(X))
- IF X'=+X
- QUIT
- SET C=C+1
- +5 IF C>12
- WRITE !,$CHAR(7),$CHAR(7),"I can't fit ",C," facilities on this report, please select 1-12 facilities."
- GOTO F
- ZIS ;call to XBDBQUE
- DEMO ;
- +1 DO DEMOCHK^APCLUTL(.APCLDEMO)
- +2 IF APCLDEMO=-1
- GOTO LOC
- +3 SET XBRP="^APCLAP5P"
- SET XBRC="^APCLAP51"
- SET XBRX="XIT^APCLAP5"
- SET XBNS="APCL"
- +4 DO ^XBDBQUE
- +5 DO XIT
- +6 QUIT
- XIT ;
- +1 KILL APCL1,APCL2,APCLAP,APCLBD,APCLBDD,APCLBT,APCLBTH,APCLCLNT,APCLCLOC,APCLDISC,APCLDT,APCLED,APCLEDD,APCLET,APCLJOB,APCLL,APCLLENG,APCLLOC,APCLLOCT,APCLODAT,APCLPG
- +2 KILL APCLPRIM,APCLQUIT,APCLSD,APCLSITE,APCLSKIP,APCLSORT,APCLVD,APCLVDFN,APCLVREC,APCLX,APCLY
- +3 KILL IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M,DA,D0,DR,DIC,DIE,C,DIR,DIRUT,DR,%DT,DTOUT,DUOUT,J,X,X1,X2
- +4 QUIT
- INFORM ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !!,"This report will tally the number of visits by primary care providers, by date",!,"at the locations or to the clinics that you specify. ",!
- +3 WRITE "A total number of 6 locations or clinics will fit on an 80 column report,",!,"you may specify up to 12 if you print the report with 132 columns."
- +4 QUIT
- +5 ;
