Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ZIBRPRTD

ZIBRPRTD.m

Go to the documentation of this file. 
  1. ZIBRPRTD ; IHS/ADC/GTH - ROUTINE PRINT ; [ 10/29/2002   7:42 AM ]
  1.  ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
  1.  ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
  1.  ; This routine lists routines edited after given date.
  1.  ;
  1. BEGIN ;
  1.  ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
  1.  ;I ^%ZOSF("OS")'["MSM" D OSNO^XB Q
  1.  ;S X="ERR^ZIBRPRTD",@^%ZOSF("TRAP")
  1.  ;W !?10,$P($P($ZV,","),"-")," - Routine Print Utility"
  1.  NEW ZIBOS
  1.  S ZIBOS=$$VERSION^%ZOSV(1)
  1.  I '(ZIBOS["Cache"),'(ZIBOS["MSM") D OSNO^XB Q
  1.  I ZIBOS["MSM" S X="ERR^ZIBRPRTD",@^%ZOSF("TRAP")
  1.  I ZIBOS["Cache" S X="BACK^%ETN",@^%ZOSF("TRAP")
  1.  W !?10,ZIBOS," - Routine Print Utility"
  1.  ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
  1. RSEL ;
  1.  S %DEV=$I
  1.  U 0
  1.  KILL QUIT
  1.  ;X ^%ZOSF("RSEL") ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  S %R=1 X ^%ZOSF("RSEL") ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  ;I $D(QUIT) W !,"No routines selected" G EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  I $D(QUIT)!(%R=0) W !,"No routines selected" G EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  S XBTYPE="PRINT"
  1.  D ^XBDATE ;ADDED TO SPECIFY A DATE AND SCREEN OUT ROUTINES EDITED SINCE SPECIFIED DATE
  1.  I $D(QUIT) W !,"No routines will be printed." H 2 G EXIT
  1. SDEV ;
  1.  ;I %DEV=$I D PR^%SDEV G:$D(QUIT) EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  D ^%ZIS G:POP EXIT S %DEV=IO ;IHS/SET/GTH XB*3*9 10/29/2002
  1. F1 ;
  1.  S %LPP=60,%W=132
  1.  W !!,"Lines per page <",%LPP,">: "
  1.  R %I:$G(DTIME,999)
  1.  I %I="" S %I=%LPP W %I
  1.  I %I'?1N.N G:%I="^" SDEV:$I'=%DEV,RSEL G:%I="^Q" EXIT W !,*7,"Response must be positive numeric" G F1
  1.  S %LPP=+%I
  1. F2 ;
  1.  W !,"Characters per line <",%W,">: "
  1.  R %I:$G(DTIME,999)
  1.  I %I="" S %I=%W W %I
  1.  I %I'?1N.N G EXIT:%I="^Q",F1:%I="^" W !,*7,"Response must be positive numeric" G F2
  1.  S %W=+%I,%L=%W-18-63,%CMT=""
  1.  G:%L'>0 START
  1. CMT ;
  1.  R !,"Enter comment for page header : ",%CMT:$G(DTIME,999)
  1.  G F2:%CMT="^",CMT1:%CMT'="?"
  1.  W !,"The comment will be displayed with the UCI, date, and time on each page header."
  1.  G CMT
  1.  ;
  1. CMT1 ;
  1.  I $L(%CMT)>%L W !,*7,"Too long. Maximum comment length is ",%L G CMT
  1. START ;
  1.  D INT^%T,INT^%D
  1.  D FORMAT
  1.  U %DEV
  1.  ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
  1.  ;W !!
  1.  ;I %DEV<20!(%DEV>63) U %DEV:%W
  1.  ;U 0
  1.  I ZIBOS["Cache" W @IOF
  1.  I %DEV<20!(%DEV>63),ZIBOS["MSM" U %DEV:%W
  1.  U $P
  1.  ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
  1.  W !!,"Done. "
  1. EXIT ;
  1.  ;U 0 ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  ;I '$D(QUIT),%DEV'=$I,+%DEV S IO=%DEV D ^%ZISC ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  I '$D(QUIT),%DEV'=$I S IO=%DEV D ^%ZISC ;IHS/SET/GTH XB*3*9 10/29/2002
  1.  KILL %DEV,%LPP,%W,%I,%J,%CMT,%TIM,%TIM1,%DAT,%DAT1,%PG,%PGG,%RN,%L,%R,%X,%,%BLK,QUIT
  1.  Q
  1.  ;
  1. ERR ;EP - If error, from error trap.
  1.  I $F($$Z^ZIBNSSV("ERROR"),"<INRPT>") U 0 W !!,"...Aborted." D EXIT V 0:$J:$ZB($V(0,$J,2),#0400,7):2
  1.  ZQ
  1.  ;
  1. FORMAT ;
  1.  S %PG=1,%PGG=1
  1.  W !!,"Printing ...",!
  1. F3 ;
  1.  ;Begin adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
  1.  ;S %X="W:$Y # W !,""Routine: "",%RN,?20,""UCI: "",$ZU(0),""  Date/Time: "",%DAT1,"", "",%TIM1,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
  1.  ;U %DEV
  1.  ;I %DEV<20!(%DEV>63) U %DEV:%W
  1.  ;S %RN=""
  1.  ;F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN=""  X:$V(8,$J,2)'=$I "U 0 W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV" D F4 S %PG=%PG+1,%PGG=1
  1.  S:ZIBOS["MSM" %X="W:$Y # W !,""Routine: "",%RN,?20,""UCI: "",$ZU(0),""  Date/Time: "",%DAT1,"", "",%TIM1,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
  1.  S:ZIBOS["Cache" %X="W:$Y # W !,""Routine: "",%RN,?20,""Namespace: "",$ZU(5),""  Date/Time: "",%DAT,"", "",%TIM,?$X+3,%CMT,?%W-18,""Page: "",%PG,""-"",%PGG,! S %PGG=%PGG+1"
  1.  U %DEV
  1.  I ZIBOS["MSM" D
  1.  . I %DEV<20!(%DEV>63) U %DEV:%W
  1.  . S %RN=""
  1.  . F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN=""  X:$V(8,$J,2)'=$I "U 0 W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV" D F4 S %PG=%PG+1,%PGG=1
  1.  I ZIBOS["Cache" D
  1.  . S %RN=0
  1.  . F %I=1:1 S %RN=$O(^UTILITY($J,%RN)) Q:%RN=""  X "U $P W ?$S($X=0:0,1:$X+10\10*10-1),%RN W:$X>70 ! U %DEV" D F4 S %PG=%PG+1,%PGG=1
  1.  ;End adds/edits;IHS/SET/GTH XB*3*9 10/29/2002
  1.  Q
  1.  ;
  1. F4 ;
  1.  X %X
  1.  X "ZL @%RN F %I=1:1 S %J=$T(+%I) Q:%J=""""  S %L=$P(%J,"" ""),%R=$P(%J,"" "",2,255) X:$Y>%LPP %X W !,%L,?10 F %J=1:%W-10:255 S %L=$E(%R,1,%W-10),%R=$E(%R,%W-10+1,255) W %L Q:%R=""""  X:$Y>%LPP %X W !,"".........."""
  1.  Q
  1.  ;