KMPRP1 ;SFISC/RAK - RUM Data by Option ;4 Nov 1998
;;1.0;CAPACITY MANAGEMENT - RUM;;Dec 09, 1998
EN ;-- entry point.
;
N %ZIS,CONT,DIC,IORVOFF,IORVON,KMPRDATE,KMPROPT,OUT,POP
N X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
;
D ZIS^KMPRUTL
S OUT=0
F D Q:OUT
.W @IOF,!,?30,IORVON," RUM Data by Option ",IORVOFF,!
.K DIC S DIC=19,DIC(0)="AEMQZ",DIC("A")="Select Option: "
.W ! D ^DIC I Y<0 S OUT=1 Q
.S KMPROPT=+Y_"^"_Y(0,0)
.; determine start date from file 8971.1
.D RUMDATES^KMPRUTL(.KMPRDATE)
.Q:'KMPRDATE
.; select output device.
.S %ZIS="Q",%ZIS("A")="Device: ",%ZIS("B")="HOME"
.W ! D ^%ZIS I POP W !,"No action taken." Q
.; if queued.
.I $D(IO("Q")) K IO("Q") D Q
..S ZTDESC="RUM Data by Option for '"_$P(KMPROPT,U,2)_"'."
..S ZTRTN="EN1^KMPRP1"
..S ZTSAVE("KMPRDATE")="",ZTSAVE("KMPROPT")=""
..D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
..D EXIT
.;
.; if output to terminal display message.
.W:$E(IOST,1,2)="C-" !?3,"...compiling data..."
.D EN1
Q
;
EN1 ;-- entry point from taskman.
;
Q:'$G(KMPRDATE)
Q:$G(KMPROPT)=""
;
N ELEMENT,KMPRARRY,KMPRDAYS
;
; set elements data into ELEMENT() array.
D ELEARRY^KMPRUTL("ELEMENT") Q:'$D(ELEMENT)
S KMPRARRY=$NA(^TMP("KMPR OPT DATA",$J))
K @KMPRARRY
D DATA,PRINT,EXIT
K @KMPRARRY
;
Q
;
DATA ;-- set data into KMPRARRY
Q:'$D(ELEMENT)
Q:$G(KMPRARRY)=""
Q:'$G(KMPRDATE)
Q:$G(KMPROPT)=""
;
N DATE,END,I,IEN,OPTION,START
;
; start and end dates.
S START=$P(KMPRDATE,U),END=$P(KMPRDATE,U,2)
S DATE=START-.1,KMPRDAYS=0
F S DATE=$O(^KMPR(8971.1,"B",DATE)) Q:'DATE!(DATE>END) D
.S IEN=0,KMPRDAYS=KMPRDAYS+1
.F S IEN=$O(^KMPR(8971.1,"B",DATE,IEN)) Q:'IEN D
..Q:'$D(^KMPR(8971.1,IEN,0)) S DATA(0)=^(0),DATA(1)=$G(^(1)),DATA(2)=$G(^(2))
..S OPTION=$P(DATA(0),U,4)
..Q:OPTION'=$P(KMPROPT,U,2)
..F I=1:1:8 D
...S $P(@KMPRARRY@(OPTION),U,I)=$P($G(@KMPRARRY@(OPTION)),U,I)+$P(DATA(1),U,I)
...S $P(@KMPRARRY@(OPTION),U,I)=$P($G(@KMPRARRY@(OPTION)),U,I)+$P(DATA(2),U,I)
;
Q
;
EXIT ;
S:$D(ZTQUEUED) ZTREQ="@"
D ^%ZISC
K KMPUDATE,KMPUNAM
;
Q
;
PRINT ;-- print data from KMPRARRY.
Q:'$D(ELEMENT)
Q:$G(KMPRARRY)=""
;
U IO
;
N DATA,OCCUR,I,NUMBER,PIECE,SITE
;
; facility name.
S SITE=$$SITE^VASITE
S SITE=$P(SITE,U,2)_" ("_$P(SITE,U,3)_")"
;
I '$D(@KMPRARRY) D Q
.D HDR
.W !!!?28,"<<<No Data to Report>>>"
.W !! D CONTINUE^KMPRUTL("Press RETURN to continue",.CONT)
;
S OPTION=""
F S OPTION=$O(@KMPRARRY@(OPTION)) Q:OPTION="" D
.D HDR S DATA=@KMPRARRY@(OPTION),I=0,OCCUR=$P(DATA,U,8)
.F S I=$O(ELEMENT(I)) Q:'I D
..W !,$P(ELEMENT(I),U) S PIECE=$P(ELEMENT(I),U,2)
..W $$REPEAT^XLFSTR(".",25-$X)
..S NUMBER=$P(DATA,U,PIECE)
..; per occurrence.
..W:PIECE'=8 ?28,$J($FN(NUMBER/OCCUR,",",$S(I<3:2,1:0)),$S(I<3:14,1:11))
..W ?50,$J($FN(NUMBER,",",$S(I<3:2,1:0)),$S(I<3:18,1:15))
;
W !! D CONTINUE^KMPRUTL("Press RETURN to continue",.CONT)
;
Q
;
HDR ;
N TITLE
W:$Y @IOF
S TITLE="RUM Data for Option: "_$P(KMPROPT,U,2)
W !?(80-$L(TITLE)\2),TITLE
W !?(80-$L($G(SITE))\2),$G(SITE)
W !?23,"For "_$P($G(KMPRDATE),U,3)_" to "_$P($G(KMPRDATE),U,4)
W !
W !?28,"per Occurrence",?50," Totals"
W !
;
Q
KMPRP1 ;SFISC/RAK - RUM Data by Option ;4 Nov 1998
+1 ;;1.0;CAPACITY MANAGEMENT - RUM;;Dec 09, 1998
EN ;-- entry point.
+1 ;
+2 NEW %ZIS,CONT,DIC,IORVOFF,IORVON,KMPRDATE,KMPROPT,OUT,POP
+3 NEW X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+4 ;
+5 DO ZIS^KMPRUTL
+6 SET OUT=0
+7 FOR
Begin DoDot:1
+8 WRITE @IOF,!,?30,IORVON," RUM Data by Option ",IORVOFF,!
+9 KILL DIC
SET DIC=19
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Option: "
+10 WRITE !
DO ^DIC
IF Y<0
SET OUT=1
QUIT
+11 SET KMPROPT=+Y_"^"_Y(0,0)
+12 ; determine start date from file 8971.1
+13 DO RUMDATES^KMPRUTL(.KMPRDATE)
+14 IF 'KMPRDATE
QUIT
+15 ; select output device.
+16 SET %ZIS="Q"
SET %ZIS("A")="Device: "
SET %ZIS("B")="HOME"
+17 WRITE !
DO ^%ZIS
IF POP
WRITE !,"No action taken."
QUIT
+18 ; if queued.
+19 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:2
+20 SET ZTDESC="RUM Data by Option for '"_$PIECE(KMPROPT,U,2)_"'."
+21 SET ZTRTN="EN1^KMPRP1"
+22 SET ZTSAVE("KMPRDATE")=""
SET ZTSAVE("KMPROPT")=""
+23 DO ^%ZTLOAD
IF $GET(ZTSK)
WRITE !,"Task #",ZTSK
+24 DO EXIT
End DoDot:2
QUIT
+25 ;
+26 ; if output to terminal display message.
+27 IF $EXTRACT(IOST,1,2)="C-"
WRITE !?3,"...compiling data..."
+28 DO EN1
End DoDot:1
IF OUT
QUIT
+29 QUIT
+30 ;
EN1 ;-- entry point from taskman.
+1 ;
+2 IF '$GET(KMPRDATE)
QUIT
+3 IF $GET(KMPROPT)=""
QUIT
+4 ;
+5 NEW ELEMENT,KMPRARRY,KMPRDAYS
+6 ;
+7 ; set elements data into ELEMENT() array.
+8 DO ELEARRY^KMPRUTL("ELEMENT")
IF '$DATA(ELEMENT)
QUIT
+9 SET KMPRARRY=$NAME(^TMP("KMPR OPT DATA",$JOB))
+10 KILL @KMPRARRY
+11 DO DATA
DO PRINT
DO EXIT
+12 KILL @KMPRARRY
+13 ;
+14 QUIT
+15 ;
DATA ;-- set data into KMPRARRY
+1 IF '$DATA(ELEMENT)
QUIT
+2 IF $GET(KMPRARRY)=""
QUIT
+3 IF '$GET(KMPRDATE)
QUIT
+4 IF $GET(KMPROPT)=""
QUIT
+5 ;
+6 NEW DATE,END,I,IEN,OPTION,START
+7 ;
+8 ; start and end dates.
+9 SET START=$PIECE(KMPRDATE,U)
SET END=$PIECE(KMPRDATE,U,2)
+10 SET DATE=START-.1
SET KMPRDAYS=0
+11 FOR
SET DATE=$ORDER(^KMPR(8971.1,"B",DATE))
IF 'DATE!(DATE>END)
QUIT
Begin DoDot:1
+12 SET IEN=0
SET KMPRDAYS=KMPRDAYS+1
+13 FOR
SET IEN=$ORDER(^KMPR(8971.1,"B",DATE,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+14 IF '$DATA(^KMPR(8971.1,IEN,0))
QUIT
SET DATA(0)=^(0)
SET DATA(1)=$GET(^(1))
SET DATA(2)=$GET(^(2))
+15 SET OPTION=$PIECE(DATA(0),U,4)
+16 IF OPTION'=$PIECE(KMPROPT,U,2)
QUIT
+17 FOR I=1:1:8
Begin DoDot:3
+18 SET $PIECE(@KMPRARRY@(OPTION),U,I)=$PIECE($GET(@KMPRARRY@(OPTION)),U,I)+$PIECE(DATA(1),U,I)
+19 SET $PIECE(@KMPRARRY@(OPTION),U,I)=$PIECE($GET(@KMPRARRY@(OPTION)),U,I)+$PIECE(DATA(2),U,I)
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
+22 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO ^%ZISC
+3 KILL KMPUDATE,KMPUNAM
+4 ;
+5 QUIT
+6 ;
PRINT ;-- print data from KMPRARRY.
+1 IF '$DATA(ELEMENT)
QUIT
+2 IF $GET(KMPRARRY)=""
QUIT
+3 ;
+4 USE IO
+5 ;
+6 NEW DATA,OCCUR,I,NUMBER,PIECE,SITE
+7 ;
+8 ; facility name.
+9 SET SITE=$$SITE^VASITE
+10 SET SITE=$PIECE(SITE,U,2)_" ("_$PIECE(SITE,U,3)_")"
+11 ;
+12 IF '$DATA(@KMPRARRY)
Begin DoDot:1
+13 DO HDR
+14 WRITE !!!?28,"<<<No Data to Report>>>"
+15 WRITE !!
DO CONTINUE^KMPRUTL("Press RETURN to continue",.CONT)
End DoDot:1
QUIT
+16 ;
+17 SET OPTION=""
+18 FOR
SET OPTION=$ORDER(@KMPRARRY@(OPTION))
IF OPTION=""
QUIT
Begin DoDot:1
+19 DO HDR
SET DATA=@KMPRARRY@(OPTION)
SET I=0
SET OCCUR=$PIECE(DATA,U,8)
+20 FOR
SET I=$ORDER(ELEMENT(I))
IF 'I
QUIT
Begin DoDot:2
+21 WRITE !,$PIECE(ELEMENT(I),U)
SET PIECE=$PIECE(ELEMENT(I),U,2)
+22 WRITE $$REPEAT^XLFSTR(".",25-$X)
+23 SET NUMBER=$PIECE(DATA,U,PIECE)
+24 ; per occurrence.
+25 IF PIECE'=8
WRITE ?28,$JUSTIFY($FNUMBER(NUMBER/OCCUR,",",$SELECT(I<3:2,1:0)),$SELECT(I<3:14,1:11))
+26 WRITE ?50,$JUSTIFY($FNUMBER(NUMBER,",",$SELECT(I<3:2,1:0)),$SELECT(I<3:18,1:15))
End DoDot:2
End DoDot:1
+27 ;
+28 WRITE !!
DO CONTINUE^KMPRUTL("Press RETURN to continue",.CONT)
+29 ;
+30 QUIT
+31 ;
HDR ;
+1 NEW TITLE
+2 IF $Y
WRITE @IOF
+3 SET TITLE="RUM Data for Option: "_$PIECE(KMPROPT,U,2)
+4 WRITE !?(80-$LENGTH(TITLE)\2),TITLE
+5 WRITE !?(80-$LENGTH($GET(SITE))\2),$GET(SITE)
+6 WRITE !?23,"For "_$PIECE($GET(KMPRDATE),U,3)_" to "_$PIECE($GET(KMPRDATE),U,4)
+7 WRITE !
+8 WRITE !?28,"per Occurrence",?50," Totals"
+9 WRITE !
+10 ;
+11 QUIT
