KMPRP1 ;OAK/RAK - RUM Data by Option/Protocol/RPC ;11/29/04 08:47
;;2.0;CAPACITY MANAGEMENT - RUM;**1**;May 28, 2003
EN ;-- entry point.
;
N %ZIS,CONT,KMPRDATE,KMPROPR,KMPROPT,OUT,POP
N X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
;
S OUT=0
F D Q:OUT
.D HDR^KMPDUTL4(" RUM Data by Option/Protocol/RPC ")
.S KMPROPR=$$OPR I 'KMPROPR S OUT=1 Q
.; select option, protocol or rpc entry
.S KMPROPT=$$OPRSEL(KMPROPR) Q:'KMPROPT
.; 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("KMPROPR")="",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(KMPROPR)
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(KMPROPR)
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=$$OPRCHK(KMPROPR,KMPROPT,DATA(0)) Q:OPTION=""
..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>>>"
.D CONTINUE^KMPDUTL4("Press RETURN to continue",2,.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:OCCUR&(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))
;
D CONTINUE^KMPDUTL4("Press RETURN to continue",2,.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
;
OPR() ;-- extrinsic function - select option, protocol or rpc
;-----------------------------------------------------------------------
; Return: 1 - Option
; 2 - Protocol
; 3 - RPC
; "" - No selection made
;-----------------------------------------------------------------------
N DIR,X,Y
S DIR(0)="SO^1:Option;2:Protocol;3:RPC"
D ^DIR
Q $S(Y:Y_"^"_$G(Y(0)),1:"")
;
OPRCHK(OPR,OPT,DATA) ;-- extrinsic function - check to see if option, protocol or rpc matches
;-----------------------------------------------------------------------
; OPR.... Results from $$OPR above.
; OPT.... Option, protocol or rpc name to be matched
; DATA... Zero node of file 8971.1 (RESOURCE USAGE MONITOR)
;
; Return: OptionName - match
; "" - no match
;-----------------------------------------------------------------------
Q:$G(OPR)="" ""
Q:'OPR!($P(OPR,U,2)="") ""
Q:'$D(DATA) ""
Q:(+OPR)<1!((+OPR)>3) ""
N OPTION
; option - piece 4, protocol - piece 5, rpc - piece7
S OPTION=$S((+OPR)=1:$P(DATA,U,4),(+OPR)=2:$P(DATA,U,5),1:$P(DATA,U,7))
Q $S(OPTION="":"",OPTION'=$P(OPT,U,2):"",1:OPTION)
;
OPRSEL(OPR) ;-- extrinsic function - select entry
;-----------------------------------------------------------------------
; OPT.... Results from $$OPR above.
;
; Return: IEN^Name - this will be from the Option file, Protocol file,
; or RPC file, depending on the value of OPR.
; "" - no selection made
;-----------------------------------------------------------------------
Q:'$G(OPR) ""
Q:OPR<1!(OPR>3) ""
N DIC,X,Y
; 1 - option, 2 - protocol, 3 - rpc
S DIC=$S((+OPR)=1:19,(+OPR)=2:101,1:8994)
S DIC(0)="AEMQZ",DIC("A")="Select "_$P(OPR,U,2)_": "
W ! D ^DIC
Q $S(Y<0:"",1:+Y_"^"_Y(0,0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPRP1 5127 printed Oct 16, 2024@17:42:29 Page 2
KMPRP1 ;OAK/RAK - RUM Data by Option/Protocol/RPC ;11/29/04 08:47
+1 ;;2.0;CAPACITY MANAGEMENT - RUM;**1**;May 28, 2003
EN ;-- entry point.
+1 ;
+2 NEW %ZIS,CONT,KMPRDATE,KMPROPR,KMPROPT,OUT,POP
+3 NEW X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+4 ;
+5 SET OUT=0
+6 FOR
Begin DoDot:1
+7 DO HDR^KMPDUTL4(" RUM Data by Option/Protocol/RPC ")
+8 SET KMPROPR=$$OPR
IF 'KMPROPR
SET OUT=1
QUIT
+9 ; select option, protocol or rpc entry
+10 SET KMPROPT=$$OPRSEL(KMPROPR)
if 'KMPROPT
QUIT
+11 ; determine start date from file 8971.1
+12 DO RUMDATES^KMPRUTL(.KMPRDATE)
if 'KMPRDATE
QUIT
+13 ; select output device.
+14 SET %ZIS="Q"
SET %ZIS("A")="Device: "
SET %ZIS("B")="HOME"
+15 WRITE !
DO ^%ZIS
IF POP
WRITE !,"No action taken."
QUIT
+16 ; if queued.
+17 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:2
+18 SET ZTDESC="RUM Data by Option for '"_$PIECE(KMPROPT,U,2)_"'."
+19 SET ZTRTN="EN1^KMPRP1"
+20 SET ZTSAVE("KMPRDATE")=""
SET ZTSAVE("KMPROPR")=""
SET ZTSAVE("KMPROPT")=""
+21 DO ^%ZTLOAD
if $GET(ZTSK)
WRITE !,"Task #",ZTSK
+22 DO EXIT
End DoDot:2
QUIT
+23 ;
+24 ; if output to terminal display message.
+25 if $EXTRACT(IOST,1,2)="C-"
WRITE !?3,"compiling data..."
+26 DO EN1
End DoDot:1
if OUT
QUIT
+27 ;
+28 QUIT
+29 ;
EN1 ;-- entry point from taskman.
+1 ;
+2 if '$GET(KMPRDATE)
QUIT
+3 if '$GET(KMPROPR)
QUIT
+4 if $GET(KMPROPT)=""
QUIT
+5 ;
+6 NEW ELEMENT,KMPRARRY,KMPRDAYS
+7 ;
+8 ; set elements data into ELEMENT() array.
+9 DO ELEARRY^KMPRUTL("ELEMENT")
if '$DATA(ELEMENT)
QUIT
+10 SET KMPRARRY=$NAME(^TMP("KMPR OPT DATA",$JOB))
+11 KILL @KMPRARRY
+12 DO DATA
DO PRINT
DO EXIT
+13 KILL @KMPRARRY
+14 ;
+15 QUIT
+16 ;
DATA ;-- set data into KMPRARRY
+1 if '$DATA(ELEMENT)
QUIT
+2 if $GET(KMPRARRY)=""
QUIT
+3 if '$GET(KMPRDATE)
QUIT
+4 if '$GET(KMPROPR)
QUIT
+5 if $GET(KMPROPT)=""
QUIT
+6 ;
+7 NEW DATE,END,I,IEN,OPTION,START
+8 ;
+9 ; start and end dates.
+10 SET START=$PIECE(KMPRDATE,U)
SET END=$PIECE(KMPRDATE,U,2)
+11 SET DATE=START-.1
SET KMPRDAYS=0
+12 FOR
SET DATE=$ORDER(^KMPR(8971.1,"B",DATE))
if 'DATE!(DATE>END)
QUIT
Begin DoDot:1
+13 SET IEN=0
SET KMPRDAYS=KMPRDAYS+1
+14 FOR
SET IEN=$ORDER(^KMPR(8971.1,"B",DATE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+15 if '$DATA(^KMPR(8971.1,IEN,0))
QUIT
SET DATA(0)=^(0)
SET DATA(1)=$GET(^(1))
SET DATA(2)=$GET(^(2))
+16 SET OPTION=$$OPRCHK(KMPROPR,KMPROPT,DATA(0))
if OPTION=""
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 DO CONTINUE^KMPDUTL4("Press RETURN to continue",2,.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 OCCUR&(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 DO CONTINUE^KMPDUTL4("Press RETURN to continue",2,.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
+12 ;
OPR() ;-- extrinsic function - select option, protocol or rpc
+1 ;-----------------------------------------------------------------------
+2 ; Return: 1 - Option
+3 ; 2 - Protocol
+4 ; 3 - RPC
+5 ; "" - No selection made
+6 ;-----------------------------------------------------------------------
+7 NEW DIR,X,Y
+8 SET DIR(0)="SO^1:Option;2:Protocol;3:RPC"
+9 DO ^DIR
+10 QUIT $SELECT(Y:Y_"^"_$GET(Y(0)),1:"")
+11 ;
OPRCHK(OPR,OPT,DATA) ;-- extrinsic function - check to see if option, protocol or rpc matches
+1 ;-----------------------------------------------------------------------
+2 ; OPR.... Results from $$OPR above.
+3 ; OPT.... Option, protocol or rpc name to be matched
+4 ; DATA... Zero node of file 8971.1 (RESOURCE USAGE MONITOR)
+5 ;
+6 ; Return: OptionName - match
+7 ; "" - no match
+8 ;-----------------------------------------------------------------------
+9 if $GET(OPR)=""
QUIT ""
+10 if 'OPR!($PIECE(OPR,U,2)="")
QUIT ""
+11 if '$DATA(DATA)
QUIT ""
+12 if (+OPR)<1!((+OPR)>3)
QUIT ""
+13 NEW OPTION
+14 ; option - piece 4, protocol - piece 5, rpc - piece7
+15 SET OPTION=$SELECT((+OPR)=1:$PIECE(DATA,U,4),(+OPR)=2:$PIECE(DATA,U,5),1:$PIECE(DATA,U,7))
+16 QUIT $SELECT(OPTION="":"",OPTION'=$PIECE(OPT,U,2):"",1:OPTION)
+17 ;
OPRSEL(OPR) ;-- extrinsic function - select entry
+1 ;-----------------------------------------------------------------------
+2 ; OPT.... Results from $$OPR above.
+3 ;
+4 ; Return: IEN^Name - this will be from the Option file, Protocol file,
+5 ; or RPC file, depending on the value of OPR.
+6 ; "" - no selection made
+7 ;-----------------------------------------------------------------------
+8 if '$GET(OPR)
QUIT ""
+9 if OPR<1!(OPR>3)
QUIT ""
+10 NEW DIC,X,Y
+11 ; 1 - option, 2 - protocol, 3 - rpc
+12 SET DIC=$SELECT((+OPR)=1:19,(+OPR)=2:101,1:8994)
+13 SET DIC(0)="AEMQZ"
SET DIC("A")="Select "_$PIECE(OPR,U,2)_": "
+14 WRITE !
DO ^DIC
+15 QUIT $SELECT(Y<0:"",1:+Y_"^"_Y(0,0))
