APSPAMIS ; IHS/DSD/ENM - BHAM ISC/SAB/IHS/ENM - IHS PHARMACY AMIS REP ; [ 09/03/97 1:30 PM ]
;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
W ! S %DT(0)=-DT,%DT("A")="PRINT AMIS STATS STARTING: " S %DT="EPXA" D ^%DT G:"^"[X END G APSPAMIS:Y<0 S SDT=Y K %DT(0)
EDT W ! S %DT(0)=SDT,%DT("A")="ENDING STATS DATE: " D ^%DT G:"^"[X END S EDT=Y I Y<0 G EDT K %DT
ZDIV ;IHS/DSD/ENM 10/16/96 ASK DIV MODULE ADDED
S DIR(0)="Y",DIR("A")="Would you like all divisions",DIR("B")="YES",DIR("?")="Enter 'Yes' or 'No'" D ^DIR K DIR Q:$D(DTOUT)
I "Yy"[X S APSPANS="A" G DEV
S DIR(0)="PO^59:EMZ",DIR("A")="Select Division",DIR("?")="Enter the Division Name or Number "
D ^DIR G:$D(DTOUT)!$D(DUOUT) END K DIR
S APSPANS=+Y
;IHS/DSD/ENM 10/16/96 END OF ASK DIV MODULE
DEV K %ZIS,IOP,ZTSK S %ZIS("B")="",PSOION=ION,%ZIS="QM" D ^%ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION G END
;I $E(IOST)["C"!($G(IOM)<132) W *7,!!,"PRINTOUT MUST BE SENT TO A 132 COLUMNS PRINTER !!",!! G DEV ;IHS/DSD/ENM DISABLED 5.15.95
K PSOION I $D(IO("Q")) S ZTDESC="Option to print the Outpatient AMIS report",ZTRTN="ENQ^APSPAMIS" F G="SDT","EDT","APSPANS" S:$D(@G) ZTSAVE(G)=""
I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued !" K G,ZTSAVE,ZTSK,Y,X,%DT G END
ENQ ;START COMPUTATIONS
K ^TMP($J) D COM S PSDATE=SDT-1 F G=0:0 S PSDATE=$O(^PS(59.1,PSDATE)) Q:'PSDATE!(PSDATE>EDT)!($D(DUOUT)) F I=0:0 S I=$O(^PS(59.1,PSDATE,1,I)) Q:'I!($D(DUOUT)) D ;IHS/DSD/ENM 5.15.95
.S ^TMP($J,I,PSDATE)=$P(^PS(59.1,PSDATE,1,I,0),"^",2)_"^"_$P(^PS(59.1,PSDATE,1,I,0),"^",7,8)_"^"_$P(^PS(59.1,PSDATE,1,I,0),"^",10,12)_"^"_$P(^PS(59.1,PSDATE,1,I,0),"^",14,17) D
..F G=1:1:10 S DAT(I,G)=$P(^TMP($J,I,PSDATE),"^",G)+DAT(I,G),GT(G)=$P(^TMP($J,I,PSDATE),"^",G)+GT(G)
S GR=0
F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV!($D(DUOUT)) D:GR SUB D RPT F PSDATE=0:0 S PSDATE=$O(^TMP($J,DIV,PSDATE)) Q:'PSDATE!($D(DUOUT)) S DAT=^(PSDATE) D:$Y+4>IOSL RPT W !,$E(PSDATE,4,5)_"-"_$E(PSDATE,6,8)_"-"_$E(PSDATE,2,3) D S GR=1,ST=DIV
.F K=1:1:10 W $J($P(DAT,"^",K),9)
.I $Y+4>IOSL,IOST["C-" D FZZ Q:$D(DUOUT)!($D(DTOUT)) ;IHS/DSD/ENM 5.95
Q:$D(DUOUT)!($D(DTOUT)) ;IHS/DSD/ENM 5.95
D SUB,GR
;
END W ! W:$E(IOST)'["C" @IOF D ^%ZISC K GR,ST,%DT,G,SDT,EDT,X,Y,POP,^TMP($J),K,PSDATE,I,DAT,G,GT,DIV S:$D(ZTQUEUED) ZTREQ="@"
Q
RPT ; HEADER
Q:$D(DUOUT)!($D(DTOUT))
U IO W @IOF,!?55,"A M I S R E P O R T",!!?40,"FROM "_$E(SDT,4,5)_"-"_$E(SDT,6,7)_"-"_$E(SDT,2,3),?60,"TO "_$E(EDT,4,5)_"-"_$E(EDT,6,7)_"-"_$E(EDT,2,3)_" DIVISION: "_$P(^PS(59,DIV,0),"^")
W !!,"DATE " F K=1:1:10 W $J($P("INPAT^OTHER^CNTLD^PAT REQ^FEE^STAFF^NEW^REFILL^WINDOW^MAIL","^",K),9)
W ! F K=1:1:132 W "-"
Q
COM ;COMPILE SUB-TOTALS AND GRAND TOTALS
F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV F G=1:1:10 S (DAT(DIV,G),GT(G))=0
Q
SUB ;PRINT SUB TOTALS
;I $Y+2>IOSL,IOST["C-" D FZZ Q:$D(DUOUT)!($D(DTOUT)) ;IHS/DSD/ENM 5.95
;W:$Y+2>IOSL @IOF W !?8 F K=1:1:10 W $J("-------",9)
W !,"SUB-TOTALS",!,?8 F K=1:1:10 W:$D(ST) $J(DAT(ST,K),9)
I $Y+2>IOSL,IOST["C-" D FZZ Q:$D(DUOUT)!($D(DTOUT)) ;IHS/DSD/ENM 5.95
W:$Y+2>IOSL @IOF W !?8 F K=1:1:10 W $J("-------",9)
Q
GR ;PRINT GRAND TOTALS
I $Y+4>IOSL,IOST["C-" D FZZ Q:$D(DUOUT)!($D(DTOUT)) ;IHS/DSD/ENM 5.95
W:$Y+4>IOSL @IOF W !?8 F K=1:1:10 W $J("-------",9)
W !,"GRAND TOTALS",!,?8 F K=1:1:10 W $J(GT(K),9)
W ! Q
FZZ ;IHS/DSD/ENM CAUSE A PAUSE 5.95
K DTOUT,DUOUT,DIR S DIR("?")="Enter '^' to halt or Press Return to Continue",DIR(0)="FO",DIR("A")="Press Return to Continue or '^' to Halt" D ^DIR
Q
APSPAMIS ; IHS/DSD/ENM - BHAM ISC/SAB/IHS/ENM - IHS PHARMACY AMIS REP ; [ 09/03/97 1:30 PM ]
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
+2 WRITE !
SET %DT(0)=-DT
SET %DT("A")="PRINT AMIS STATS STARTING: "
SET %DT="EPXA"
DO ^%DT
IF "^"[X
GOTO END
IF Y<0
GOTO APSPAMIS
SET SDT=Y
KILL %DT(0)
EDT WRITE !
SET %DT(0)=SDT
SET %DT("A")="ENDING STATS DATE: "
DO ^%DT
IF "^"[X
GOTO END
SET EDT=Y
IF Y<0
GOTO EDT
KILL %DT
ZDIV ;IHS/DSD/ENM 10/16/96 ASK DIV MODULE ADDED
+1 SET DIR(0)="Y"
SET DIR("A")="Would you like all divisions"
SET DIR("B")="YES"
SET DIR("?")="Enter 'Yes' or 'No'"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)
QUIT
+2 IF "Yy"[X
SET APSPANS="A"
GOTO DEV
+3 SET DIR(0)="PO^59:EMZ"
SET DIR("A")="Select Division"
SET DIR("?")="Enter the Division Name or Number "
+4 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO END
KILL DIR
+5 SET APSPANS=+Y
+6 ;IHS/DSD/ENM 10/16/96 END OF ASK DIV MODULE
DEV KILL %ZIS,IOP,ZTSK
SET %ZIS("B")=""
SET PSOION=ION
SET %ZIS="QM"
DO ^%ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
KILL IOP,PSOION
GOTO END
+1 ;I $E(IOST)["C"!($G(IOM)<132) W *7,!!,"PRINTOUT MUST BE SENT TO A 132 COLUMNS PRINTER !!",!! G DEV ;IHS/DSD/ENM DISABLED 5.15.95
+2 KILL PSOION
IF $DATA(IO("Q"))
SET ZTDESC="Option to print the Outpatient AMIS report"
SET ZTRTN="ENQ^APSPAMIS"
FOR G="SDT","EDT","APSPANS"
IF $DATA(@G)
SET ZTSAVE(G)=""
+3 IF $TEST
KILL IO("Q")
DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"Report Queued !"
KILL G,ZTSAVE,ZTSK,Y,X,%DT
GOTO END
ENQ ;START COMPUTATIONS
+1 ;IHS/DSD/ENM 5.15.95
KILL ^TMP($JOB)
DO COM
SET PSDATE=SDT-1
FOR G=0:0
SET PSDATE=$ORDER(^PS(59.1,PSDATE))
IF 'PSDATE!(PSDATE>EDT)!($DATA(DUOUT))
QUIT
FOR I=0:0
SET I=$ORDER(^PS(59.1,PSDATE,1,I))
IF 'I!($DATA(DUOUT))
QUIT
Begin DoDot:1
+2 SET ^TMP($JOB,I,PSDATE)=$PIECE(^PS(59.1,PSDATE,1,I,0),"^",2)_"^"_$PIECE(^PS(59.1,PSDATE,1,I,0),"^",7,8)_"^"_$PIECE(^PS(59.1,PSDATE,1,I,0),"^",10,12)_"^"_$PIECE(^PS(59.1,PSDATE,1,I,0),"^",14,17)
Begin DoDot:2
+3 FOR G=1:1:10
SET DAT(I,G)=$PIECE(^TMP($JOB,I,PSDATE),"^",G)+DAT(I,G)
SET GT(G)=$PIECE(^TMP($JOB,I,PSDATE),"^",G)+GT(G)
End DoDot:2
End DoDot:1
+4 SET GR=0
+5 FOR DIV=0:0
SET DIV=$ORDER(^PS(59,DIV))
IF 'DIV!($DATA(DUOUT))
QUIT
IF GR
DO SUB
DO RPT
FOR PSDATE=0:0
SET PSDATE=$ORDER(^TMP($JOB,DIV,PSDATE))
IF 'PSDATE!($DATA(DUOUT))
QUIT
SET DAT=^(PSDATE)
IF $Y+4>IOSL
DO RPT
WRITE !,$EXTRACT(PSDATE,4,5)_"-"_$EXTRACT(PSDATE,6,8)_"-"_$EXTRACT(PSDATE,2,3)
Begin DoDot:1
+6 FOR K=1:1:10
WRITE $JUSTIFY($PIECE(DAT,"^",K),9)
+7 ;IHS/DSD/ENM 5.95
IF $Y+4>IOSL
IF IOST["C-"
DO FZZ
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
End DoDot:1
SET GR=1
SET ST=DIV
+8 ;IHS/DSD/ENM 5.95
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+9 DO SUB
DO GR
+10 ;
END WRITE !
IF $EXTRACT(IOST)'["C"
WRITE @IOF
DO ^%ZISC
KILL GR,ST,%DT,G,SDT,EDT,X,Y,POP,^TMP($JOB),K,PSDATE,I,DAT,G,GT,DIV
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 QUIT
RPT ; HEADER
+1 IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+2 USE IO
WRITE @IOF,!?55,"A M I S R E P O R T",!!?40,"FROM "_$EXTRACT(SDT,4,5)_"-"_$EXTRACT(SDT,6,7)_"-"_$EXTRACT(SDT,2,3),?60,"TO "_$EXTRACT(EDT,4,5)_"-"_$EXTRACT(EDT,6,7)_"-"_$EXTRACT(EDT,2,3)_" DIVISION: "_$PIECE(^PS(59,DIV,0),"^")
+3 WRITE !!,"DATE "
FOR K=1:1:10
WRITE $JUSTIFY($PIECE("INPAT^OTHER^CNTLD^PAT REQ^FEE^STAFF^NEW^REFILL^WINDOW^MAIL","^",K),9)
+4 WRITE !
FOR K=1:1:132
WRITE "-"
+5 QUIT
COM ;COMPILE SUB-TOTALS AND GRAND TOTALS
+1 FOR DIV=0:0
SET DIV=$ORDER(^PS(59,DIV))
IF 'DIV
QUIT
FOR G=1:1:10
SET (DAT(DIV,G),GT(G))=0
+2 QUIT
SUB ;PRINT SUB TOTALS
+1 ;I $Y+2>IOSL,IOST["C-" D FZZ Q:$D(DUOUT)!($D(DTOUT)) ;IHS/DSD/ENM 5.95
+2 ;W:$Y+2>IOSL @IOF W !?8 F K=1:1:10 W $J("-------",9)
+3 WRITE !,"SUB-TOTALS",!,?8
FOR K=1:1:10
IF $DATA(ST)
WRITE $JUSTIFY(DAT(ST,K),9)
+4 ;IHS/DSD/ENM 5.95
IF $Y+2>IOSL
IF IOST["C-"
DO FZZ
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+5 IF $Y+2>IOSL
WRITE @IOF
WRITE !?8
FOR K=1:1:10
WRITE $JUSTIFY("-------",9)
+6 QUIT
GR ;PRINT GRAND TOTALS
+1 ;IHS/DSD/ENM 5.95
IF $Y+4>IOSL
IF IOST["C-"
DO FZZ
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+2 IF $Y+4>IOSL
WRITE @IOF
WRITE !?8
FOR K=1:1:10
WRITE $JUSTIFY("-------",9)
+3 WRITE !,"GRAND TOTALS",!,?8
FOR K=1:1:10
WRITE $JUSTIFY(GT(K),9)
+4 WRITE !
QUIT
FZZ ;IHS/DSD/ENM CAUSE A PAUSE 5.95
+1 KILL DTOUT,DUOUT,DIR
SET DIR("?")="Enter '^' to halt or Press Return to Continue"
SET DIR(0)="FO"
SET DIR("A")="Press Return to Continue or '^' to Halt"
DO ^DIR
+2 QUIT
