61 lines
4.3 KiB
Mathematica
61 lines
4.3 KiB
Mathematica
PRCPRPC2 ;WISC/RFJ/DWA-patient distribution costs (print report) ;11 Mar 94
|
|
;;5.1;IFCAP;**32**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
PRINT ; print report
|
|
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|
S ORROOM=""
|
|
; show report variables selected
|
|
W !!?10,"*** R E P O R T V A R I A B L E S S E L E C T E D ***",!
|
|
W !,"SURGICAL SPECIALTY RANGE FROM : ",$S(PRCPSURS="":"FIRST",1:PRCPSURS),?60,"TO: ",$S(PRCPSURE="z":"LAST",1:PRCPSURE)
|
|
W !,"PATIENT NAME RANGE FROM : ",$S(PRCPPATS="":"FIRST",1:PRCPPATS),?60,"TO: ",$S(PRCPPATE="z":"LAST",1:PRCPPATE)
|
|
W !,"OPERATION/PROCEDURE CODE RANGE FROM: ",$S(PRCPOPCS="":"FIRST",1:PRCPOPCS),?60,"TO: ",$S(PRCPOPCE="z":"LAST",1:PRCPOPCE)
|
|
S Y=DATESTRT D DD^%DT W !,"DISTRIBUTION DATES FROM : ",Y S Y=DATEEND D DD^%DT W ?60,"TO: ",Y,!
|
|
W !,"PRINT SUMMARY ONLY : ",$S(PRCPSUMM=1:"YES",1:"NO")
|
|
W !,"PRINT ITEMS ON REPORT: ",$S($G(PRCPFITM)=1:"YES",1:"NO")
|
|
;
|
|
S DISTRNM="" F S DISTRNM=$O(^TMP($J,"PRCPRPCR",DISTRNM)) Q:DISTRNM=""!($G(PRCPFLAG)) S SURGSPEC="" F S SURGSPEC=$O(^TMP($J,"PRCPRPCR",DISTRNM,SURGSPEC)) Q:SURGSPEC=""!($G(PRCPFLAG)) D
|
|
. I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
|
|
. I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
. I '$G(PRCPSUMM) W !!?5,"FROM Inventory Point: ",DISTRNM,?40,"TO Surgical Specialty: ",SURGSPEC
|
|
. S INOUTPAT="" F S INOUTPAT=$O(^TMP($J,"PRCPRPCR",DISTRNM,SURGSPEC,INOUTPAT)) Q:INOUTPAT=""!($G(PRCPFLAG)) D
|
|
. . S PATNAME="" F S PATNAME=$O(^TMP($J,"PRCPRPCR",DISTRNM,SURGSPEC,INOUTPAT,PATNAME)) Q:PATNAME=""!($G(PRCPFLAG)) D
|
|
. . . S OPCODE="" F S OPCODE=$O(^TMP($J,"PRCPRPCR",DISTRNM,SURGSPEC,INOUTPAT,PATNAME,OPCODE)) Q:OPCODE=""!($G(PRCPFLAG)) D
|
|
. . . . S DA=0 F S DA=$O(^TMP($J,"PRCPRPCR",DISTRNM,SURGSPEC,INOUTPAT,PATNAME,OPCODE,DA)) Q:'DA!($G(PRCPFLAG)) S DATA=^(DA) D
|
|
. . . . . S SURGEON=$E($$USER^PRCPUREP(+$P(DATA,"^",2)),1,15) I SURGEON="" S SURGEON=" "
|
|
. . . . . S TOTCOST=$P(DATA,"^",3)
|
|
. . . . . ; accumulate totals
|
|
. . . . . S %=$G(^TMP($J,"PRCPRPCRT",1,DISTRNM)),$P(%,"^")=$P(%,"^")+1,$P(%,"^",2)=$P(%,"^",2)+TOTCOST,^(DISTRNM)=%
|
|
. . . . . S %=$G(^TMP($J,"PRCPRPCRT",2,SURGSPEC)),$P(%,"^")=$P(%,"^")+1,$P(%,"^",2)=$P(%,"^",2)+TOTCOST,^(SURGSPEC)=%
|
|
. . . . . S %=$G(^TMP($J,"PRCPRPCRT",2,SURGSPEC,INOUTPAT)),$P(%,"^")=$P(%,"^")+1,$P(%,"^",2)=$P(%,"^",2)+TOTCOST,^(INOUTPAT)=%
|
|
. . . . . S %=$G(^TMP($J,"PRCPRPCRT",3,INOUTPAT)),$P(%,"^")=$P(%,"^")+1,$P(%,"^",2)=$P(%,"^",2)+TOTCOST,^(INOUTPAT)=%
|
|
. . . . . S %=$G(^TMP($J,"PRCPRPCRT",4,OPCODE)),$P(%,"^")=$P(%,"^")+1,$P(%,"^",2)=$P(%,"^",2)+TOTCOST,^(OPCODE)=%
|
|
. . . . . S %=$G(^TMP($J,"PRCPRPCRT",5,SURGEON)),$P(%,"^")=$P(%,"^")+1,$P(%,"^",2)=$P(%,"^",2)+TOTCOST,^(SURGEON)=%
|
|
. . . . . S %=$G(^TMP($J,"PRCPRPCRT",6)),$P(%,"^")=$P(%,"^")+1,$P(%,"^",2)=$P(%,"^",2)+TOTCOST,^(6)=%
|
|
. . . . . I $G(PRCPSUMM) Q
|
|
. . . . . ;
|
|
. . . . . S Y=DA D DD^%DT S DATE=$P(Y,",")
|
|
. . . . . I $P(DATA,"^")'="" S ORROOM=$E($P($G(^SC($P($G(^SRS(+$P(DATA,"^"),0)),"^"),0)),"^"),1,10)
|
|
. . . . . S:ORROOM="" ORROOM="N/A"
|
|
. . . . . W !,PATNAME,?12,INOUTPAT,?17,OPCODE,?26,DATE,?35,SURGEON,?52,ORROOM,?65,$J(TOTCOST,15,2) S ORROOM=""
|
|
. . . . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
. . . . . I $G(PRCPFITM)=1 S ITEMDA=0 F S ITEMDA=$O(^PRCP(446.1,DA,445,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S DATA=$G(^(ITEMDA,0)) I DATA'="" D
|
|
. . . . . . W !?10,"IM# ",ITEMDA,?20,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,25),?50,"QTY: ",+$P(DATA,"^",2),?65,$J(+$P(DATA,"^",3),15,2)
|
|
. . . . . . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
I $G(PRCPFLAG) Q
|
|
K ORROOM
|
|
;
|
|
; print report totals
|
|
D PRINTOTL^PRCPRPC3
|
|
Q
|
|
;
|
|
;
|
|
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|
W $C(13),"PATIENT DISTRIBUTION COST REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
|
|
S %="",$P(%,"-",81)=""
|
|
I $G(PRCPFTOT) W !,"*** R E P O R T T O T A L S ***",?46,$J("COUNT",10),$J("TOTAL COST",12),$J("AVERAGE",12),!,% Q
|
|
W !,"NAME-SSN",?11,"IO",?17,"OPCODE",?26,"DATE",?35,"SURGEON",?52,"OR ROOM",?70,"TOTAL COST",!,%
|
|
Q
|