- 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 Feb 18, 2025@23:08 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))