ADCFPALL ;OHPRD-ISD-IHS/THL;PRINT SEQUENCE TO PRODUCE ALL TECH DOC REPORTS [ 05/16/91 12:18 PM ]
;;1;PACKAGE DOCUMENT UTILITIES
EN S ADCFLAG="",IOP="HOME"
D ^%ZIS,^ADCHD
F ADC="PRE","VER","SELECT","ZIS","PALL" Q:ADCFLAG="OUT" D @ADC
EXIT X ^%ZIS("C") K %IS,DXS I $D(ZTSK) K ^%ZTSK(ZTSK)
I IOST["C-" D ^ADCMH
K ADCFLAG,ADCPALL,ADCDATA,ADCFLDS,ADCBY,ADCFR,ADCIO,ADCIOP,ADCX,ADCI,ADCVER,ADCROUT,ADCFILES,ADCLI,ADCCNT,ADCDFN,ADCEND,ADCES,BY,FLDS,FR,TO,POP
Q
PRE W !!
S DIC="^DIC(9.4,",DIC(0)="AEMQZ",DIC("A")="Select PACKAGE: "
D ^DIC K DIK,DIC
I +Y<1 S ADCFLAG="OUT" Q
S ADCDFN=+Y,ADCFR=$P(Y(0),U,2)
Q
VER W !
S DA=ADCDFN,DIC="^DIC(9.4,"_DA_",22,",DIC(0)="AEMQZ" S:$D(^DIC(9.4,DA,"VERSION")) DIC("B")=^("VERSION")
D ^DIC K DIC
I +Y<1 S ADCFLAG="OUT" Q
S ADCVER=+Y
Q
SELECT W:$D(IOF) @IOF
S ADCX="SELECT PACKAGE REPORTS"
W !?80-$L(ADCX)\2,ADCX,!
F ADCI=1:1:9 W !?10,$J(ADCI,2)_") ",$P($T(TEXT1+ADCI),";;",2) W:ADCI'=9 ?45,$J(ADCI+9,2)_") ",$P($T(TEXT1+(ADCI+9)),";;",2)
S DIR(0)="LO^1:17",DIR("A")="Which REPORTS",DIR("?",1)="To select several REPORTS separate them with commas.",DIR("?")="For example: ==> 1,3,7,9 "
W !
D DIR
I ADCFLAG="OUT" G ROUT
S ADCQK=Y
S:$E(ADCQK,$L(ADCQK))="," ADCQK=$E(ADCQK,1,$L(ADCQK)-1)
ROUT K ADCROUT
S DIR(0)="YO",DIR("A")="Print FIRTS LINE of all ROUTINES listed in the PACKAGE ROUTINE field",DIR("B")="NO"
W !
D DIR
S:Y=1 ADCROUT=""
K ADCFILES
S DIR(0)="YO",DIR("A")="Include brief listing of all package FILES",DIR("B")="NO"
W !
D DIR
S:Y=1 ADCFILES=""
I $D(ADCROUT)!$D(ADCFILES) S ADCFLAG=""
Q
ZIS K ZTSK,IOP,%ZIS
S %IS="PMQ" W !
D ^%ZIS
I $D(POP),POP S ADCFLAG="OUT" Q
S ADCIOP=ION_";"_IOST_";"_IOM_";"_IOSL
I IO=IO(0),$D(IO("Q")) W !,"Cannot Queue to Screen or Slave Printer!",! K IO("Q") G ZIS
I ION["HOST" S ADCIOPAR=IOPAR S:$D(IO("HFSIO")) ADCIO("HFSIO")=IO("HFSIO")
I $D(IO("Q")) D ZTLOAD
Q
ZTLOAD S ZTIO=IO
S ZTSAVE("ADC*")=""
S ZTDESC="PACKAGE DOCUMENTATION"
S ZTRTN="PALL^ADCFPALL"
D ^%ZTLOAD
K IO("Q"),ZTSK,ZTDESC,ZTIO,ZTRTN,ZTSAVE
S ADCFLAG="OUT"
Q
DIR D ^DIR S:$D(DIRUT) ADCFLAG="OUT" K DIR,DIRUT,DUOUT,DTOUT
Q
PALL G:'$D(ADCQK) LOOPEND
N ADCI
I ADCQK=17 D Q
.F ADCI=101:1:116 B D SETUP
.D LOOPEND
LOOP S ADCCNT=$L(ADCQK,",")
F ADCLI=1:1:ADCCNT S ADCI=$P(ADCQK,",",ADCLI) S ADCI=ADCI+100 D SETUP
LOOPEND D:$D(ADCROUT) ROUTINES
D:$D(ADCFILES) FILES
Q
ROUTINES Q:'$D(^DIC(9.4,ADCDFN,2))
K ^UTILITY("XBRPTL",$J)
N ADCI
S ADCX=""
F ADCI=0:0 S ADCX=$O(^DIC(9.4,ADCDFN,2,"B",ADCX)) Q:ADCX="" S ^UTILITY($J,ADCX)=""
S IOP=ADCIOP
I IOP["HOST" S %ZIS("IOPAR")=ADCIOPAR S:$D(ADCIO("HFSIO")) IO("HFSIO")=ADCIO("HFSIO")
D ^%ZIS
U IO
D EN^XBRPTL K XBRPTL
Q
FILES Q:'$D(^DIC(9.4,ADCDFN,4))
K ^UTILITY("XBDSET",$J)
N ADCI
S ADCX="" F ADCI=0:0 S ADCX=$O(^DIC(9.4,ADCDFN,4,"B",ADCX)) Q:ADCX="" S ^UTILITY("XBDSET",$J,ADCX)=""
S IOP=ADCIOP
I IOP["HOST" S %ZIS("IOPAR")=ADCIOPAR S:$D(ADCIO("HFSIO")) IO("HFSIO")=ADCIO("HFSIO")
D ^%ZIS
U IO D EN^XBFLD
K ^UTILITY("XBDSET",$J)
X ^%ZIS("C")
Q
SETUP S ADCDATA=$T(@ADCI),ADCDATA=$P(ADCDATA,";;",2,99)
Q:ADCDATA=""
S DIC=$P(ADCDATA,";",3),FLDS="[ADC "_$P(ADCDATA,";")_"]",BY="[ADC "_$P(ADCDATA,";",2)_"]",(ADCTO,ADCFR)=$P(ADCFR,",") S:DIC'["9.4" ADCTO=ADCFR_"z"
I $P(ADCDATA,";",4)="VER" S (ADCFR,ADCTO)=ADCFR_","_ADCVER
S FR=ADCFR,TO=ADCTO,IOP=ADCIOP
N ADCI
I IOP["HOST" S %ZIS("IOPAR")=ADCIOPAR S:$D(ADCIO("HFSIO")) IO("HFSIO")=ADCIO("HFSIO")
D EN1^DIP
Q
TEXT ;
101 ;;INSTALL;INSTALL SORT;^DIC(9.4,;VER;
102 ;;ENHANCEMENTS;INSTALL SORT;^DIC(9.4,;VER;
103 ;;RELEASE NOTES;INSTALL SORT;^DIC(9.4,;VER;
104 ;;DESCRIPTION;FILE LISTNG SORT;^DIC(9.4,;
105 ;;SYS REQUIRE;INSTALL SORT;^DIC(9.4,;VER;
106 ;;OPTIONS;OPTION NAME SORT;^DIC(19,;
107 ;;OPTION DESC;OPTION NAME SORT;^DIC(19,;
108 ;;SECURITY KEY LISTING;SECURITY KEY LISTNG SORT;^DIC(19.1,;
109 ;;HELP FRAME LIST - HELP;HELP FRAME SORT;^DIC(9.2,;
110 ;;HELP FRAME INFORMATION;HELP FRAME INFO SORT;^DIC(9.2,;
111 ;;FILE LISTING;FILE LISTNG SORT;^DIC(9.4,;
112 ;;FILE SECURITY;FILE DESC/SEC SORT;^DIC(9.4,;
113 ;;INPUT TEMPLATE;INPUT TEMPLATE SORT;^DIE(;
114 ;;PRINT TEMPLATE;PRINT TEMPLATE SORT;^DIPT(;
115 ;;SORT TEMPLATE;SORT TEMPLATE SORT;^DIBT(;
116 ;;PROGRAMMER NOTES;PROGRAMMER NOTES SORT;^DIC(9.4,;VER;
;
TEXT1 ;
1 ;;INSTALLATION INSTRUCTIONS
2 ;;VERSION ENHANCEMENTS
3 ;;RELEASE NOTES
4 ;;PACKAGE DESCRIPTION
5 ;;SYSTEMS REQUIREMENTS
6 ;;OPTIONS
7 ;;OPTION DESCRIPTIONS
8 ;;SECURITY KEYS
9 ;;PACKAGE HELP FRAMES
10 ;;CONTENT OF HELP FRAME
11 ;;PACKAGE FILES
12 ;;FILE DESCRIPTIONS
13 ;;PACKAGE INPUT TEMPLATES
14 ;;PACKAGE PRINT TEMPLATES
15 ;;PACKAGE SORT TEMPLATES
16 ;;PROGRAMMER NOTES
17 ;;PRINT ALL REPORTS
ADCFPALL ;OHPRD-ISD-IHS/THL;PRINT SEQUENCE TO PRODUCE ALL TECH DOC REPORTS [ 05/16/91 12:18 PM ]
+1 ;;1;PACKAGE DOCUMENT UTILITIES
EN SET ADCFLAG=""
SET IOP="HOME"
+1 DO ^%ZIS
DO ^ADCHD
+2 FOR ADC="PRE","VER","SELECT","ZIS","PALL"
IF ADCFLAG="OUT"
QUIT
DO @ADC
EXIT XECUTE ^%ZIS("C")
KILL %IS,DXS
IF $DATA(ZTSK)
KILL ^%ZTSK(ZTSK)
+1 IF IOST["C-"
DO ^ADCMH
+2 KILL ADCFLAG,ADCPALL,ADCDATA,ADCFLDS,ADCBY,ADCFR,ADCIO,ADCIOP,ADCX,ADCI,ADCVER,ADCROUT,ADCFILES,ADCLI,ADCCNT,ADCDFN,ADCEND,ADCES,BY,FLDS,FR,TO,POP
+3 QUIT
PRE WRITE !!
+1 SET DIC="^DIC(9.4,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Select PACKAGE: "
+2 DO ^DIC
KILL DIK,DIC
+3 IF +Y<1
SET ADCFLAG="OUT"
QUIT
+4 SET ADCDFN=+Y
SET ADCFR=$PIECE(Y(0),U,2)
+5 QUIT
VER WRITE !
+1 SET DA=ADCDFN
SET DIC="^DIC(9.4,"_DA_",22,"
SET DIC(0)="AEMQZ"
IF $DATA(^DIC(9.4,DA,"VERSION"))
SET DIC("B")=^("VERSION")
+2 DO ^DIC
KILL DIC
+3 IF +Y<1
SET ADCFLAG="OUT"
QUIT
+4 SET ADCVER=+Y
+5 QUIT
SELECT IF $DATA(IOF)
WRITE @IOF
+1 SET ADCX="SELECT PACKAGE REPORTS"
+2 WRITE !?80-$LENGTH(ADCX)\2,ADCX,!
+3 FOR ADCI=1:1:9
WRITE !?10,$JUSTIFY(ADCI,2)_") ",$PIECE($TEXT(TEXT1+ADCI),";;",2)
IF ADCI'=9
WRITE ?45,$JUSTIFY(ADCI+9,2)_") ",$PIECE($TEXT(TEXT1+(ADCI+9)),";;",2)
+4 SET DIR(0)="LO^1:17"
SET DIR("A")="Which REPORTS"
SET DIR("?",1)="To select several REPORTS separate them with commas."
SET DIR("?")="For example: ==> 1,3,7,9 "
+5 WRITE !
+6 DO DIR
+7 IF ADCFLAG="OUT"
GOTO ROUT
+8 SET ADCQK=Y
+9 IF $EXTRACT(ADCQK,$LENGTH(ADCQK))=","
SET ADCQK=$EXTRACT(ADCQK,1,$LENGTH(ADCQK)-1)
ROUT KILL ADCROUT
+1 SET DIR(0)="YO"
SET DIR("A")="Print FIRTS LINE of all ROUTINES listed in the PACKAGE ROUTINE field"
SET DIR("B")="NO"
+2 WRITE !
+3 DO DIR
+4 IF Y=1
SET ADCROUT=""
+5 KILL ADCFILES
+6 SET DIR(0)="YO"
SET DIR("A")="Include brief listing of all package FILES"
SET DIR("B")="NO"
+7 WRITE !
+8 DO DIR
+9 IF Y=1
SET ADCFILES=""
+10 IF $DATA(ADCROUT)!$DATA(ADCFILES)
SET ADCFLAG=""
+11 QUIT
ZIS KILL ZTSK,IOP,%ZIS
+1 SET %IS="PMQ"
WRITE !
+2 DO ^%ZIS
+3 IF $DATA(POP)
IF POP
SET ADCFLAG="OUT"
QUIT
+4 SET ADCIOP=ION_";"_IOST_";"_IOM_";"_IOSL
+5 IF IO=IO(0)
IF $DATA(IO("Q"))
WRITE !,"Cannot Queue to Screen or Slave Printer!",!
KILL IO("Q")
GOTO ZIS
+6 IF ION["HOST"
SET ADCIOPAR=IOPAR
IF $DATA(IO("HFSIO"))
SET ADCIO("HFSIO")=IO("HFSIO")
+7 IF $DATA(IO("Q"))
DO ZTLOAD
+8 QUIT
ZTLOAD SET ZTIO=IO
+1 SET ZTSAVE("ADC*")=""
+2 SET ZTDESC="PACKAGE DOCUMENTATION"
+3 SET ZTRTN="PALL^ADCFPALL"
+4 DO ^%ZTLOAD
+5 KILL IO("Q"),ZTSK,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+6 SET ADCFLAG="OUT"
+7 QUIT
DIR DO ^DIR
IF $DATA(DIRUT)
SET ADCFLAG="OUT"
KILL DIR,DIRUT,DUOUT,DTOUT
+1 QUIT
PALL IF '$DATA(ADCQK)
GOTO LOOPEND
+1 NEW ADCI
+2 IF ADCQK=17
Begin DoDot:1
+3 FOR ADCI=101:1:116
BREAK
DO SETUP
+4 DO LOOPEND
End DoDot:1
QUIT
LOOP SET ADCCNT=$LENGTH(ADCQK,",")
+1 FOR ADCLI=1:1:ADCCNT
SET ADCI=$PIECE(ADCQK,",",ADCLI)
SET ADCI=ADCI+100
DO SETUP
LOOPEND IF $DATA(ADCROUT)
DO ROUTINES
+1 IF $DATA(ADCFILES)
DO FILES
+2 QUIT
ROUTINES IF '$DATA(^DIC(9.4,ADCDFN,2))
QUIT
+1 KILL ^UTILITY("XBRPTL",$JOB)
+2 NEW ADCI
+3 SET ADCX=""
+4 FOR ADCI=0:0
SET ADCX=$ORDER(^DIC(9.4,ADCDFN,2,"B",ADCX))
IF ADCX=""
QUIT
SET ^UTILITY($JOB,ADCX)=""
+5 SET IOP=ADCIOP
+6 IF IOP["HOST"
SET %ZIS("IOPAR")=ADCIOPAR
IF $DATA(ADCIO("HFSIO"))
SET IO("HFSIO")=ADCIO("HFSIO")
+7 DO ^%ZIS
+8 USE IO
+9 DO EN^XBRPTL
KILL XBRPTL
+10 QUIT
FILES IF '$DATA(^DIC(9.4,ADCDFN,4))
QUIT
+1 KILL ^UTILITY("XBDSET",$JOB)
+2 NEW ADCI
+3 SET ADCX=""
FOR ADCI=0:0
SET ADCX=$ORDER(^DIC(9.4,ADCDFN,4,"B",ADCX))
IF ADCX=""
QUIT
SET ^UTILITY("XBDSET",$JOB,ADCX)=""
+4 SET IOP=ADCIOP
+5 IF IOP["HOST"
SET %ZIS("IOPAR")=ADCIOPAR
IF $DATA(ADCIO("HFSIO"))
SET IO("HFSIO")=ADCIO("HFSIO")
+6 DO ^%ZIS
+7 USE IO
DO EN^XBFLD
+8 KILL ^UTILITY("XBDSET",$JOB)
+9 XECUTE ^%ZIS("C")
+10 QUIT
SETUP SET ADCDATA=$TEXT(@ADCI)
SET ADCDATA=$PIECE(ADCDATA,";;",2,99)
+1 IF ADCDATA=""
QUIT
+2 SET DIC=$PIECE(ADCDATA,";",3)
SET FLDS="[ADC "_$PIECE(ADCDATA,";")_"]"
SET BY="[ADC "_$PIECE(ADCDATA,";",2)_"]"
SET (ADCTO,ADCFR)=$PIECE(ADCFR,",")
IF DIC'["9.4"
SET ADCTO=ADCFR_"z"
+3 IF $PIECE(ADCDATA,";",4)="VER"
SET (ADCFR,ADCTO)=ADCFR_","_ADCVER
+4 SET FR=ADCFR
SET TO=ADCTO
SET IOP=ADCIOP
+5 NEW ADCI
+6 IF IOP["HOST"
SET %ZIS("IOPAR")=ADCIOPAR
IF $DATA(ADCIO("HFSIO"))
SET IO("HFSIO")=ADCIO("HFSIO")
+7 DO EN1^DIP
+8 QUIT
TEXT ;
101 ;;INSTALL;INSTALL SORT;^DIC(9.4,;VER;
102 ;;ENHANCEMENTS;INSTALL SORT;^DIC(9.4,;VER;
103 ;;RELEASE NOTES;INSTALL SORT;^DIC(9.4,;VER;
104 ;;DESCRIPTION;FILE LISTNG SORT;^DIC(9.4,;
105 ;;SYS REQUIRE;INSTALL SORT;^DIC(9.4,;VER;
106 ;;OPTIONS;OPTION NAME SORT;^DIC(19,;
107 ;;OPTION DESC;OPTION NAME SORT;^DIC(19,;
108 ;;SECURITY KEY LISTING;SECURITY KEY LISTNG SORT;^DIC(19.1,;
109 ;;HELP FRAME LIST - HELP;HELP FRAME SORT;^DIC(9.2,;
110 ;;HELP FRAME INFORMATION;HELP FRAME INFO SORT;^DIC(9.2,;
111 ;;FILE LISTING;FILE LISTNG SORT;^DIC(9.4,;
112 ;;FILE SECURITY;FILE DESC/SEC SORT;^DIC(9.4,;
113 ;;INPUT TEMPLATE;INPUT TEMPLATE SORT;^DIE(;
114 ;;PRINT TEMPLATE;PRINT TEMPLATE SORT;^DIPT(;
115 ;;SORT TEMPLATE;SORT TEMPLATE SORT;^DIBT(;
116 ;;PROGRAMMER NOTES;PROGRAMMER NOTES SORT;^DIC(9.4,;VER;
+1 ;
TEXT1 ;
1 ;;INSTALLATION INSTRUCTIONS
2 ;;VERSION ENHANCEMENTS
3 ;;RELEASE NOTES
4 ;;PACKAGE DESCRIPTION
5 ;;SYSTEMS REQUIREMENTS
6 ;;OPTIONS
7 ;;OPTION DESCRIPTIONS
8 ;;SECURITY KEYS
9 ;;PACKAGE HELP FRAMES
10 ;;CONTENT OF HELP FRAME
11 ;;PACKAGE FILES
12 ;;FILE DESCRIPTIONS
13 ;;PACKAGE INPUT TEMPLATES
14 ;;PACKAGE PRINT TEMPLATES
15 ;;PACKAGE SORT TEMPLATES
16 ;;PROGRAMMER NOTES
17 ;;PRINT ALL REPORTS