- APCLRX9 ; IHS/CMI/LAB - RX'S BY DATE/TIME DISPENSED ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- START ;
- S APCLJOB=$J,APCLBTH=$H
- D INFORM
- GETDATES ;
- BD ;
- S DIR(0)="D^::EP",DIR("A")="Enter Beginning RX Release Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- G:$D(DIRUT) XIT
- S APCLBD=Y
- ED ;
- S DIR(0)="DA^::EP",DIR("A")="Enter Ending RX Release Date: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- G:$D(DIRUT) XIT
- I Y<APCLBD W !,"Ending date must be greater than or equal to beginning date!" G ED
- S APCLED=Y
- S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
- LOC ;enter DIVISION
- W !! S APCLLOC="",APCLDIVN=""
- S DIR(0)="YO",DIR("A")="Include RX's from ALL DIVISIONS",DIR("?")="If you wish to include RX's from ALL Divisions answer Yes. If you wish to tabulate for only one Division enter NO." D ^DIR K DIR
- G:$D(DIRUT) BD
- I Y=1 S APCLLOC="" G ZIS
- LOC1 ;enter DIVISION
- S DIC("A")="Which Division: ",DIC="^PS(59,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 LOC
- S APCLLOC=+Y
- I $D(DIRUT) W !!,"No Division entered." G BD
- S APCLDIVN=$P(^PS(59,APCLLOC,0),U) ;Division Printable Name
- ZIS ;
- DEMO ;
- D DEMOCHK^APCLUTL(.APCLDEMO)
- I APCLDEMO=-1 G LOC
- S XBRP="^APCLRX9P",XBRC="^APCLRX91",XBRX="XIT^APCLRX9",XBNS="APCL"
- D ^XBDBQUE
- D XIT
- Q
- XIT ;
- K APCLAPC,APCLBD,APCLBT,APCLBTH,APCLCLIN,APCLCLN,APCLED,APCLGRAN,APCLJOB,APCLLOC,APCLPG,APCLSC,APCLSD,APCLTYPE,APCLTOT,APCLVIEN,APCLX,APCLVREC
- K DFN,C,APCLLOCN,APCL1,APCL2,APCL3,APCL4,APCL5,APCL6,APCL7,APCL8,APCL9,APCL10,APCL11,APCL12,APCL13,APCLRXHR,APCLRXTM,APCLGTOT
- K DA,D0,S,TS,X,Y,DIC,DR,H,M,POP,ZTSK
- K APCL2,APCLA2P,APCL3,APCLA3P,APCLG,APCLGO,APCLJ,APCLJ10,APCLJ11,APCKJ13,APCLJ3,APCLJ4,APCLJ5,APCLJ6,APCLJ7,APCLJ8,APCLJ9,APCLDIVN
- K APCLRX1,APCLRX10,APCLRX11,APCLRX12,APCLRX13,APCLRX2,APCLRX3,APCLRX4,APCLRX5,APCLRX6,APCLRX7,APCLRX8,APCLRX9,APCLJ12,APCLJ13,APCLA2AP,APCLA3AP,APCL4,APCLA4P,APCLA4AP
- K APCL14,APCL15,APCL16,APCL17,APCLRX14,APCLRX15,APCLRX16,APCLRX17,APCLJ14,APCLJ15,APCJ16,APCLJ17,APCL14,APCL15,APCL16,APCL17
- Q
- ;
- INFORM ;
- W:$D(IOF) @IOF
- W !!,?10,"************** RX DATA ANALYSIS REPORT **************",!!
- W !,"This report will tally all RX's for the Date Range specified and break them",!,"down by Time Released & Count by Hour increments.",!!
- W ?10,"It will also allow printing the report for ALL DIVISIONS",!,?10,"or for the one specified DIVISION.",!
- W !,"ACT Total is all RX's dispensed for all Hours during specified Timeframe.",!
- W "ADJ Total excludes all evening and Non-Pharmacy RX's that are typically",!,"encoded between 8:00 AM and 9:00 AM.",!
- Q
- ;
- APCLRX9 ; IHS/CMI/LAB - RX'S BY DATE/TIME DISPENSED ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- START ;
- +1 SET APCLJOB=$JOB
- SET APCLBTH=$HOROLOG
- +2 DO INFORM
- GETDATES ;
- BD ;
- +1 SET DIR(0)="D^::EP"
- SET DIR("A")="Enter Beginning RX Release Date"
- SET DIR("?")="Enter the beginning visit date for the search."
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO XIT
- +3 SET APCLBD=Y
- ED ;
- +1 SET DIR(0)="DA^::EP"
- SET DIR("A")="Enter Ending RX Release Date: "
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO XIT
- +3 IF Y<APCLBD
- WRITE !,"Ending date must be greater than or equal to beginning date!"
- GOTO ED
- +4 SET APCLED=Y
- +5 SET X1=APCLBD
- SET X2=-1
- DO C^%DTC
- SET APCLSD=X
- LOC ;enter DIVISION
- +1 WRITE !!
- SET APCLLOC=""
- SET APCLDIVN=""
- +2 SET DIR(0)="YO"
- SET DIR("A")="Include RX's from ALL DIVISIONS"
- SET DIR("?")="If you wish to include RX's from ALL Divisions answer Yes. If you wish to tabulate for only one Division enter NO."
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- GOTO BD
- +4 IF Y=1
- SET APCLLOC=""
- GOTO ZIS
- LOC1 ;enter DIVISION
- +1 SET DIC("A")="Which Division: "
- SET DIC="^PS(59,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- KILL DIC,DA
- IF Y<0
- GOTO LOC
- +2 SET APCLLOC=+Y
- +3 IF $DATA(DIRUT)
- WRITE !!,"No Division entered."
- GOTO BD
- +4 ;Division Printable Name
- SET APCLDIVN=$PIECE(^PS(59,APCLLOC,0),U)
- ZIS ;
- DEMO ;
- +1 DO DEMOCHK^APCLUTL(.APCLDEMO)
- +2 IF APCLDEMO=-1
- GOTO LOC
- +3 SET XBRP="^APCLRX9P"
- SET XBRC="^APCLRX91"
- SET XBRX="XIT^APCLRX9"
- SET XBNS="APCL"
- +4 DO ^XBDBQUE
- +5 DO XIT
- +6 QUIT
- XIT ;
- +1 KILL APCLAPC,APCLBD,APCLBT,APCLBTH,APCLCLIN,APCLCLN,APCLED,APCLGRAN,APCLJOB,APCLLOC,APCLPG,APCLSC,APCLSD,APCLTYPE,APCLTOT,APCLVIEN,APCLX,APCLVREC
- +2 KILL DFN,C,APCLLOCN,APCL1,APCL2,APCL3,APCL4,APCL5,APCL6,APCL7,APCL8,APCL9,APCL10,APCL11,APCL12,APCL13,APCLRXHR,APCLRXTM,APCLGTOT
- +3 KILL DA,D0,S,TS,X,Y,DIC,DR,H,M,POP,ZTSK
- +4 KILL APCL2,APCLA2P,APCL3,APCLA3P,APCLG,APCLGO,APCLJ,APCLJ10,APCLJ11,APCKJ13,APCLJ3,APCLJ4,APCLJ5,APCLJ6,APCLJ7,APCLJ8,APCLJ9,APCLDIVN
- +5 KILL APCLRX1,APCLRX10,APCLRX11,APCLRX12,APCLRX13,APCLRX2,APCLRX3,APCLRX4,APCLRX5,APCLRX6,APCLRX7,APCLRX8,APCLRX9,APCLJ12,APCLJ13,APCLA2AP,APCLA3AP,APCL4,APCLA4P,APCLA4AP
- +6 KILL APCL14,APCL15,APCL16,APCL17,APCLRX14,APCLRX15,APCLRX16,APCLRX17,APCLJ14,APCLJ15,APCJ16,APCLJ17,APCL14,APCL15,APCL16,APCL17
- +7 QUIT
- +8 ;
- INFORM ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !!,?10,"************** RX DATA ANALYSIS REPORT **************",!!
- +3 WRITE !,"This report will tally all RX's for the Date Range specified and break them",!,"down by Time Released & Count by Hour increments.",!!
- +4 WRITE ?10,"It will also allow printing the report for ALL DIVISIONS",!,?10,"or for the one specified DIVISION.",!
- +5 WRITE !,"ACT Total is all RX's dispensed for all Hours during specified Timeframe.",!
- +6 WRITE "ADJ Total excludes all evening and Non-Pharmacy RX's that are typically",!,"encoded between 8:00 AM and 9:00 AM.",!
- +7 QUIT
- +8 ;
