- 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
