- APCLCP6 ; IHS/CMI/LAB - activity report print ;
- ;;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)
- I APCLSORV="APCLAP" S APCLSORT="PROVIDER",APCLNSP="APCLCP6"
- I APCLSORV="APCLSU" S APCLSORT="SERVICE UNIT",APCLNSP="APCLCP7"
- D INFORM
- GETGROUP ;
- S DIC="^APCLACTG(",DIC("A")="Enter the Provider Discipline Group you wish to report on: ",DIC(0)="AEMQ" D ^DIC K DIC
- I Y=-1 W !,"Bye ... " G XIT
- S APCLACTG=+Y
- W !!,"You have selected the ",$P(Y,U,2)," discipline group.",!
- S DIC="^APCLACTG(",DA=+Y D EN^DIQ K DIC,DA
- GETDATES ;
- BD ;get beginning date
- W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G GETGROUP
- S APCLBD=Y
- ED ;get ending date
- W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date for Search: " 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 ;get location
- K APCLLOC
- S DIR(0)="S^O:One Location;T:Taxonomy of or Selected Set of Locations;A:All Locations"
- S DIR("A")="Include visits from which set of locations",DIR("B")="A" KILL DA D ^DIR KILL DIR
- G:$D(DIRUT) BD
- I Y="A" K APCLLOC G CLINIC
- I Y="O" D O^APCLCP1 G:$D(APCLQ) LOC
- I Y="T" D T^APCLCP1 G:$D(APCLQ) LOC
- CLINIC ;
- K APCLCLN
- S DIR(0)="S^O:One Clinic;T:Taxonomy of or Selected Set of Clinics;A:All Clinics"
- S DIR("A")="Include visits from which set of clinics",DIR("B")="A" KILL DA D ^DIR KILL DIR
- G:$D(DIRUT) LOC
- I Y="A" K APCLCLN G ZIS
- I Y="O" D OC^APCLCP1 G:$D(APCLQ) CLINIC
- I Y="T" D TC^APCLCP1 G:$D(APCLQ) CLINIC
- ZIS ;
- DEMO ;
- D DEMOCHK^APCLUTL(.APCLDEMO)
- I APCLDEMO=-1 G CLINIC
- S XBRP="^APCLCP6P",XBRC="^APCLCP61",XBRX="XIT^APCLCP6",XBNS="APCL"
- D ^XBDBQUE
- D XIT
- Q
- ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
- XIT ;
- I '$D(ZTQUEUED) S IOP="HOME" D ^%ZIS U IO(0)
- K APCL80S,APCLBDD,APCLBT,APCLDT,APCLED,APCLEDD,APCLLENG,APCLLOC,APCLPG,APCLQUIT,APCL1,APCL2,APCLAP,APCLDISC,APCLODAT,APCLSD,APCLSKIP,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLX,APCLY,APCLPRIM,APCLSITE,APCLBD
- K APCLACTG,APCLJOB
- K X,X1,X2,IO("Q"),%,Y,DIRUT,POP,ZTSK,ZTQUEUED,T,S,M,TS,H,DIR,DUOUT,DTOUT,DUOUT,DLOUT,APCLVAL,APCLVALP,APCLNSP,APCLSORT,APCLSORV,APCLAP,APCLSU
- Q
- ;
- INFORM ;
- W:$D(IOF) @IOF
- W !,"Number of Individuals Seen by ",APCLSORT," for staff members in the discipline",!,"group that you select.",!
- W !,"This report displays, by location of encounter, the number of individuals",!,"seen by each provider with a discipline in the discipline group that you select."
- W !
- Q
- ;
- ;
- O ;EP one location
- K APCLQ
- S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
- I Y=-1 S APCLQ="" Q
- S APCLLOC(+Y)=""
- Q
- T ;EP taxonomy
- K APCLQ
- S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=9999999.06" D ^DIC K DIC
- I Y=-1 S APCLQ="" Q
- S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLLOC(X)=""
- Q
- OC ;EP one location
- K APCLQ
- S DIC="^DIC(40.7,",DIC(0)="AEMQ",DIC("A")="Which CLINIC: " D ^DIC K DIC
- I Y=-1 S APCLQ="" Q
- S APCLCLN(+Y)=""
- Q
- TC ;EP taxonomy
- K APCLQ
- S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=40.7" D ^DIC K DIC
- I Y=-1 S APCLQ="" Q
- S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLCLN(X)=""
- Q
- APCLCP6 ; IHS/CMI/LAB - activity report print ;
- +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 IF APCLSORV="APCLAP"
- SET APCLSORT="PROVIDER"
- SET APCLNSP="APCLCP6"
- +4 IF APCLSORV="APCLSU"
- SET APCLSORT="SERVICE UNIT"
- SET APCLNSP="APCLCP7"
- +5 DO INFORM
- GETGROUP ;
- +1 SET DIC="^APCLACTG("
- SET DIC("A")="Enter the Provider Discipline Group you wish to report on: "
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC
- +2 IF Y=-1
- WRITE !,"Bye ... "
- GOTO XIT
- +3 SET APCLACTG=+Y
- +4 WRITE !!,"You have selected the ",$PIECE(Y,U,2)," discipline group.",!
- +5 SET DIC="^APCLACTG("
- SET DA=+Y
- DO EN^DIQ
- KILL DIC,DA
- GETDATES ;
- BD ;get beginning date
- +1 WRITE !
- SET DIR(0)="D^:DT:EP"
- SET DIR("A")="Enter beginning Visit Date for Search"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO GETGROUP
- +3 SET APCLBD=Y
- ED ;get ending date
- +1 WRITE !
- SET DIR(0)="DA^"_APCLBD_":DT:EP"
- SET DIR("A")="Enter ending Visit Date for Search: "
- 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 ;
- LOC ;get location
- +1 KILL APCLLOC
- +2 SET DIR(0)="S^O:One Location;T:Taxonomy of or Selected Set of Locations;A:All Locations"
- +3 SET DIR("A")="Include visits from which set of locations"
- SET DIR("B")="A"
- KILL DA
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- GOTO BD
- +5 IF Y="A"
- KILL APCLLOC
- GOTO CLINIC
- +6 IF Y="O"
- DO O^APCLCP1
- IF $DATA(APCLQ)
- GOTO LOC
- +7 IF Y="T"
- DO T^APCLCP1
- IF $DATA(APCLQ)
- GOTO LOC
- CLINIC ;
- +1 KILL APCLCLN
- +2 SET DIR(0)="S^O:One Clinic;T:Taxonomy of or Selected Set of Clinics;A:All Clinics"
- +3 SET DIR("A")="Include visits from which set of clinics"
- SET DIR("B")="A"
- KILL DA
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- GOTO LOC
- +5 IF Y="A"
- KILL APCLCLN
- GOTO ZIS
- +6 IF Y="O"
- DO OC^APCLCP1
- IF $DATA(APCLQ)
- GOTO CLINIC
- +7 IF Y="T"
- DO TC^APCLCP1
- IF $DATA(APCLQ)
- GOTO CLINIC
- ZIS ;
- DEMO ;
- +1 DO DEMOCHK^APCLUTL(.APCLDEMO)
- +2 IF APCLDEMO=-1
- GOTO CLINIC
- +3 SET XBRP="^APCLCP6P"
- SET XBRC="^APCLCP61"
- SET XBRX="XIT^APCLCP6"
- SET XBNS="APCL"
- +4 DO ^XBDBQUE
- +5 DO XIT
- +6 QUIT
- ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
- QUIT
- XIT ;
- +1 IF '$DATA(ZTQUEUED)
- SET IOP="HOME"
- DO ^%ZIS
- USE IO(0)
- +2 KILL APCL80S,APCLBDD,APCLBT,APCLDT,APCLED,APCLEDD,APCLLENG,APCLLOC,APCLPG,APCLQUIT,APCL1,APCL2,APCLAP,APCLDISC,APCLODAT,APCLSD,APCLSKIP,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLX,APCLY,APCLPRIM,APCLSITE,APCLBD
- +3 KILL APCLACTG,APCLJOB
- +4 KILL X,X1,X2,IO("Q"),%,Y,DIRUT,POP,ZTSK,ZTQUEUED,T,S,M,TS,H,DIR,DUOUT,DTOUT,DUOUT,DLOUT,APCLVAL,APCLVALP,APCLNSP,APCLSORT,APCLSORV,APCLAP,APCLSU
- +5 QUIT
- +6 ;
- INFORM ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,"Number of Individuals Seen by ",APCLSORT," for staff members in the discipline",!,"group that you select.",!
- +3 WRITE !,"This report displays, by location of encounter, the number of individuals",!,"seen by each provider with a discipline in the discipline group that you select."
- +4 WRITE !
- +5 QUIT
- +6 ;
- +7 ;
- O ;EP one location
- +1 KILL APCLQ
- +2 SET DIC="^AUTTLOC("
- SET DIC(0)="AEMQ"
- SET DIC("A")="Which LOCATION: "
- DO ^DIC
- KILL DIC
- +3 IF Y=-1
- SET APCLQ=""
- QUIT
- +4 SET APCLLOC(+Y)=""
- +5 QUIT
- T ;EP taxonomy
- +1 KILL APCLQ
- +2 SET DIC="^ATXAX("
- SET DIC(0)="AEMQ"
- SET DIC("A")="Which TAXONOMY: "
- SET DIC("S")="I $P(^(0),U,15)=9999999.06"
- DO ^DIC
- KILL DIC
- +3 IF Y=-1
- SET APCLQ=""
- QUIT
- +4 SET X=0
- FOR
- SET X=$ORDER(^ATXAX(+Y,21,"B",X))
- IF X=""
- QUIT
- SET APCLLOC(X)=""
- +5 QUIT
- OC ;EP one location
- +1 KILL APCLQ
- +2 SET DIC="^DIC(40.7,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Which CLINIC: "
- DO ^DIC
- KILL DIC
- +3 IF Y=-1
- SET APCLQ=""
- QUIT
- +4 SET APCLCLN(+Y)=""
- +5 QUIT
- TC ;EP taxonomy
- +1 KILL APCLQ
- +2 SET DIC="^ATXAX("
- SET DIC(0)="AEMQ"
- SET DIC("A")="Which TAXONOMY: "
- SET DIC("S")="I $P(^(0),U,15)=40.7"
- DO ^DIC
- KILL DIC
- +3 IF Y=-1
- SET APCLQ=""
- QUIT
- +4 SET X=0
- FOR
- SET X=$ORDER(^ATXAX(+Y,21,"B",X))
- IF X=""
- QUIT
- SET APCLCLN(X)=""
- +5 QUIT