MAGXCVS ;WOIFO/MLH - Imaging - index conversion - summary report ; 05/18/2007 11:23
;;3.0;IMAGING;**17,25,31,54**;03-July-2009;;Build 1424
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
MAKESUMM ; entry point - construct a summary report from site data
; This expects that the site will already have created an export file.
;
N %ZIS,IOP,X,COUNT,LN,DATA,MAGIEN,PKG,CLS,TYP,SPEC,PROC,PROC2,DESC,PG
N FRQTHRS ; --- frequency threshold for abridged report
N NUPG ; ------ new-page flag
N PROCTXT ; --- procedure text
N PARENT ; ---- parent data file
N DOCCAT ; ---- document category
N OBJTYP ; ---- image object type
N SAVBYGRP ; -- save-by group
N KT ; -------- count for comparison with frequency threshold
N SUB ; ------- station or substation mnemonic
N FQFNAME ; --- fully qualified file name to process
N FNAME ; ----- file name without directory or extension
N RANGE ; ----- range of records (for documentation)
N DTIME ; ----- timeout (in seconds) for input
N FULABR ; ---- Full or Abridged report flag
;
K ^TMP($J,"MAGIXCVSTAT")
S COUNT=0
S:'$D(DTIME) DTIME=$$DTIME^XUP(DUZ)
SM1 ; set frequency threshold based on full or abridged report
;
K DIR S DIR(0)="SB^A:Abridged;F:Full"
S DIR("A")="Abridged or Full report"
S DIR("?",1)="Enter A if you wish to see the mapping only for those combinations"
S DIR("?",2)=" of source field values that occurred more than 50 times."
S DIR("?",3)=" "
S DIR("?",4)="Enter F if you wish to see the mapping for all combinations of source"
S DIR("?",5)=" field values in the range of image IENs that you mapped, even those"
S DIR("?",6)=" that occurred fewer than 50 times."
S DIR("?")=" "
D ^DIR Q:$D(DTOUT) Q:$D(DUOUT) S FRQTHRS=$S(Y="A":50,1:1)
;
SM15 ; what export file?
;
K DIR S DIR(0)="FO"
S DIR("A")="Please enter the filename of the export file to use for input"
S DIR("?")="Enter a file name, including the path, of the export file that contains the data to be summarized in the report."
D ^DIR Q:$D(DTOUT) Q:$D(DUOUT) S FQFNAME=Y
I FQFNAME="" W !!,"No filename entered. Goodbye!" Q
S %ZIS="",%ZIS("HFSNAME")=FQFNAME,%ZIS("HFSMODE")="R",IOP="HFS"
S $ET="G ERR^"_$T(+0)
D ^%ZIS I POP=1 W !,"Unable to open "_FQFNAME_". Please try again." G SM15
W ! S FNAME=$P($P(FQFNAME,"\",$L(FQFNAME,"\")),".")
S SUB=$$UCASE^MAGXCVP($P(FNAME,"_")),RANGE=$P(FNAME,"_",2)
I RANGE="" S RANGE="not given"
K ^TMP($J,"MAGIXCVSTAT") S ^TMP($J,"MAGIXCVSTAT",0)=SUB_"^"_RANGE
F LN=1:1 U IO R DATA:99999 Q:DATA="***end***" I LN>1 D ; Skip header
. S MAGIEN=$P(DATA,$C(9))
. S PKG=$P(DATA,$C(9),8) I PKG="" S PKG="(none)"
. S CLS=+$P(DATA,$C(9),9),TYP=+$P(DATA,$C(9),10),SPEC=+$P(DATA,$C(9),11)
. S PROC=+$P(DATA,$C(9),12)
. S X=$P(DATA,$C(9),13),ORIG=$S(X="":"(none)",1:$P(X,"-")_" - "_$P(X,"-",2,999))
. I ORIG="" S ORIG="(none)"
. S DESC=$$STRIP^MAGXCVP($$UCASE^MAGXCVP($P(DATA,$C(9),2))) I DESC="" S DESC="(none)"
. S PROCTXT=$$STRIP^MAGXCVP($$UCASE^MAGXCVP($P(DATA,$C(9),3))) I PROCTXT="" S PROCTXT="(none)"
. S PARENT=$P(DATA,$C(9),4) I PARENT="" S PARENT="(none)"
. S DOCCAT=$P(DATA,$C(9),5) I DOCCAT="" S DOCCAT="(none)"
. S OBJTYP=$P(DATA,$C(9),6) I OBJTYP="" S OBJTYP="(none)"
. S SAVBYGRP=$P(DATA,$C(9),7) I SAVBYGRP="" S SAVBYGRP="(none)"
. S ^(SAVBYGRP)=$G(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP,SAVBYGRP))+1
. I LN#100=0 U IO(0) W "."
. I LN#5000=0 U IO(0) W LN,!
. Q
D ^%ZISC
U IO(0) W !,"File import complete.",! G SM2
;
; Reached when an error (including end-of-file) occurs.
ERR ;
S $ET=""
D ^%ZISC
U IO(0) X "W !,$ZE" W !,"Processing interrupted after ",LN," lines.",!
;
SM2 ;
W !,"This report must be run on at least a 132-column device.",!
D EN^XUTMDEVQ("ANZRPT^"_$T(+0),"Print Image Index Summary Report",.ZTSAVE)
Q
;
ANZRPT ;
I IOM<132 W !,"This report must be run on at least a 132-column device. Goodbye!",! Q
N KT,NUPG,OBJTYP,PG,PROCTXT,SAVBYGRP
N FQUIT ; --- quit flag from header logic
N RDATE ; --- report date
;
S RDATE=$$HTE^XLFDT($H,1)
S PG=0
S FQUIT=0
S SUB=$O(^MAG(2006.1,0)) I SUB S SUB=$P($G(^MAG(2006.1,SUB,0)),U)
;
S PKG=""
F S PKG=$O(^TMP($J,"MAGIXCVSTAT",PKG)) Q:PKG="" D Q:FQUIT
. S CLS=""
. F S CLS=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS)) Q:CLS="" D Q:FQUIT
. . S TYP=""
. . F S TYP=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP)) Q:TYP="" D Q:FQUIT
. . . S PROC=""
. . . F S PROC=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC)) Q:PROC="" D Q:FQUIT
. . . . S SPEC=""
. . . . F S SPEC=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC)) Q:SPEC="" D Q:FQUIT
. . . . . S ORIG=""
. . . . . F S ORIG=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG)) Q:ORIG="" D SPEC1 Q:FQUIT
. . . . Q
. . . Q
. . Q
. Q
Q
;
SPEC1 ;
S NUPG=1
S DESC=""
F S DESC=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC)) Q:DESC="" D Q:FQUIT
. S PROCTXT=""
. F S PROCTXT=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT)) Q:PROCTXT="" D Q:FQUIT
. . S PARENT=""
. . F S PARENT=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT)) Q:PARENT="" D Q:FQUIT
. . . S DOCCAT=""
. . . F S DOCCAT=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT)) Q:DOCCAT="" D Q:FQUIT
. . . . S OBJTYP=""
. . . . F S OBJTYP=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP)) Q:OBJTYP="" D Q:FQUIT
. . . . . S SAVBYGRP=""
. . . . . F S SAVBYGRP=$O(^TMP($J,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP,SAVBYGRP)) Q:SAVBYGRP="" S KT=^(SAVBYGRP) D Q:FQUIT
. . . . . . I KT<FRQTHRS Q ; count must exceed frequency threshold
. . . . . . I ($Y>(IOSL-3))!NUPG D ANZHED Q:FQUIT
. . . . . . W DESC," ",?34,PROCTXT," ",?64,PARENT," ",?78,DOCCAT," ",?92,OBJTYP," ",?106,SAVBYGRP," ",?150,$J(KT,8),!
. . . . . . Q
. . . . . Q
. . . . Q
. . . Q
. . Q
. Q
Q
;
ANZHED ;
I PG>0,IOT="TRM"!(IOT="VTRM") D Q:FQUIT
. R !!,"Press <RETURN> to continue, or '^' to exit: ",RET:DTIME
. S FQUIT=(RET="^")
. Q
S PG=PG+1,NUPG=0
W #!,"Site: ",SUB D CTR("IMAGE INDEX GENERATION REPORT") W ?115,"DATE ",RDATE,!
;W "Range: ",RANGE
D CTR("Package: "_PKG)
W ?122,$J("PAGE "_PG,8),!
D CTR("Class: "_$S(CLS:CLS_" - "_$P($G(^MAG(2005.82,CLS,0)),"^"),1:"(none)")) W !
D CTR("Type: "_$S(TYP:TYP_" - "_$P($G(^MAG(2005.83,TYP,0)),"^"),1:"(none)")) W !
D CTR("Procedure/Event: "_$S(PROC:PROC_" - "_$P($G(^MAG(2005.85,PROC,0)),"^"),1:"(none)")) W !
D CTR("Specialty: "_$S(SPEC:SPEC_" - "_$P($G(^MAG(2005.84,SPEC,0)),"^"),1:"(none)")) W !
D CTR("Origin: "_ORIG) W !!
W ?64,"Parent",!
W "Short Description",?34,"Procedure Text",?64,"Data File",?78,"Document Cat",?92,"Object Type",?106,"Save By Group",?153,"Count",!!
Q
;
CTR(X) W ?65-($L(X)/2),X Q
EOR ;END ROUTINE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGXCVS 7911 printed Sep 23, 2025@19:47:04 Page 2
MAGXCVS ;WOIFO/MLH - Imaging - index conversion - summary report ; 05/18/2007 11:23
+1 ;;3.0;IMAGING;**17,25,31,54**;03-July-2009;;Build 1424
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
MAKESUMM ; entry point - construct a summary report from site data
+1 ; This expects that the site will already have created an export file.
+2 ;
+3 NEW %ZIS,IOP,X,COUNT,LN,DATA,MAGIEN,PKG,CLS,TYP,SPEC,PROC,PROC2,DESC,PG
+4 ; --- frequency threshold for abridged report
NEW FRQTHRS
+5 ; ------ new-page flag
NEW NUPG
+6 ; --- procedure text
NEW PROCTXT
+7 ; ---- parent data file
NEW PARENT
+8 ; ---- document category
NEW DOCCAT
+9 ; ---- image object type
NEW OBJTYP
+10 ; -- save-by group
NEW SAVBYGRP
+11 ; -------- count for comparison with frequency threshold
NEW KT
+12 ; ------- station or substation mnemonic
NEW SUB
+13 ; --- fully qualified file name to process
NEW FQFNAME
+14 ; ----- file name without directory or extension
NEW FNAME
+15 ; ----- range of records (for documentation)
NEW RANGE
+16 ; ----- timeout (in seconds) for input
NEW DTIME
+17 ; ---- Full or Abridged report flag
NEW FULABR
+18 ;
+19 KILL ^TMP($JOB,"MAGIXCVSTAT")
+20 SET COUNT=0
+21 if '$DATA(DTIME)
SET DTIME=$$DTIME^XUP(DUZ)
SM1 ; set frequency threshold based on full or abridged report
+1 ;
+2 KILL DIR
SET DIR(0)="SB^A:Abridged;F:Full"
+3 SET DIR("A")="Abridged or Full report"
+4 SET DIR("?",1)="Enter A if you wish to see the mapping only for those combinations"
+5 SET DIR("?",2)=" of source field values that occurred more than 50 times."
+6 SET DIR("?",3)=" "
+7 SET DIR("?",4)="Enter F if you wish to see the mapping for all combinations of source"
+8 SET DIR("?",5)=" field values in the range of image IENs that you mapped, even those"
+9 SET DIR("?",6)=" that occurred fewer than 50 times."
+10 SET DIR("?")=" "
+11 DO ^DIR
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
SET FRQTHRS=$SELECT(Y="A":50,1:1)
+12 ;
SM15 ; what export file?
+1 ;
+2 KILL DIR
SET DIR(0)="FO"
+3 SET DIR("A")="Please enter the filename of the export file to use for input"
+4 SET DIR("?")="Enter a file name, including the path, of the export file that contains the data to be summarized in the report."
+5 DO ^DIR
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
SET FQFNAME=Y
+6 IF FQFNAME=""
WRITE !!,"No filename entered. Goodbye!"
QUIT
+7 SET %ZIS=""
SET %ZIS("HFSNAME")=FQFNAME
SET %ZIS("HFSMODE")="R"
SET IOP="HFS"
+8 SET $ETRAP="G ERR^"_$TEXT(+0)
+9 DO ^%ZIS
IF POP=1
WRITE !,"Unable to open "_FQFNAME_". Please try again."
GOTO SM15
+10 WRITE !
SET FNAME=$PIECE($PIECE(FQFNAME,"\",$LENGTH(FQFNAME,"\")),".")
+11 SET SUB=$$UCASE^MAGXCVP($PIECE(FNAME,"_"))
SET RANGE=$PIECE(FNAME,"_",2)
+12 IF RANGE=""
SET RANGE="not given"
+13 KILL ^TMP($JOB,"MAGIXCVSTAT")
SET ^TMP($JOB,"MAGIXCVSTAT",0)=SUB_"^"_RANGE
+14 ; Skip header
FOR LN=1:1
USE IO
READ DATA:99999
if DATA="***end***"
QUIT
IF LN>1
Begin DoDot:1
+15 SET MAGIEN=$PIECE(DATA,$CHAR(9))
+16 SET PKG=$PIECE(DATA,$CHAR(9),8)
IF PKG=""
SET PKG="(none)"
+17 SET CLS=+$PIECE(DATA,$CHAR(9),9)
SET TYP=+$PIECE(DATA,$CHAR(9),10)
SET SPEC=+$PIECE(DATA,$CHAR(9),11)
+18 SET PROC=+$PIECE(DATA,$CHAR(9),12)
+19 SET X=$PIECE(DATA,$CHAR(9),13)
SET ORIG=$SELECT(X="":"(none)",1:$PIECE(X,"-")_" - "_$PIECE(X,"-",2,999))
+20 IF ORIG=""
SET ORIG="(none)"
+21 SET DESC=$$STRIP^MAGXCVP($$UCASE^MAGXCVP($PIECE(DATA,$CHAR(9),2)))
IF DESC=""
SET DESC="(none)"
+22 SET PROCTXT=$$STRIP^MAGXCVP($$UCASE^MAGXCVP($PIECE(DATA,$CHAR(9),3)))
IF PROCTXT=""
SET PROCTXT="(none)"
+23 SET PARENT=$PIECE(DATA,$CHAR(9),4)
IF PARENT=""
SET PARENT="(none)"
+24 SET DOCCAT=$PIECE(DATA,$CHAR(9),5)
IF DOCCAT=""
SET DOCCAT="(none)"
+25 SET OBJTYP=$PIECE(DATA,$CHAR(9),6)
IF OBJTYP=""
SET OBJTYP="(none)"
+26 SET SAVBYGRP=$PIECE(DATA,$CHAR(9),7)
IF SAVBYGRP=""
SET SAVBYGRP="(none)"
+27 SET ^(SAVBYGRP)=$GET(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP,SAVBYGRP))+1
+28 IF LN#100=0
USE IO(0)
WRITE "."
+29 IF LN#5000=0
USE IO(0)
WRITE LN,!
+30 QUIT
End DoDot:1
+31 DO ^%ZISC
+32 USE IO(0)
WRITE !,"File import complete.",!
GOTO SM2
+33 ;
+34 ; Reached when an error (including end-of-file) occurs.
ERR ;
+1 SET $ETRAP=""
+2 DO ^%ZISC
+3 USE IO(0)
XECUTE "W !,$ZE"
WRITE !,"Processing interrupted after ",LN," lines.",!
+4 ;
SM2 ;
+1 WRITE !,"This report must be run on at least a 132-column device.",!
+2 DO EN^XUTMDEVQ("ANZRPT^"_$TEXT(+0),"Print Image Index Summary Report",.ZTSAVE)
+3 QUIT
+4 ;
ANZRPT ;
+1 IF IOM<132
WRITE !,"This report must be run on at least a 132-column device. Goodbye!",!
QUIT
+2 NEW KT,NUPG,OBJTYP,PG,PROCTXT,SAVBYGRP
+3 ; --- quit flag from header logic
NEW FQUIT
+4 ; --- report date
NEW RDATE
+5 ;
+6 SET RDATE=$$HTE^XLFDT($HOROLOG,1)
+7 SET PG=0
+8 SET FQUIT=0
+9 SET SUB=$ORDER(^MAG(2006.1,0))
IF SUB
SET SUB=$PIECE($GET(^MAG(2006.1,SUB,0)),U)
+10 ;
+11 SET PKG=""
+12 FOR
SET PKG=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG))
if PKG=""
QUIT
Begin DoDot:1
+13 SET CLS=""
+14 FOR
SET CLS=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS))
if CLS=""
QUIT
Begin DoDot:2
+15 SET TYP=""
+16 FOR
SET TYP=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP))
if TYP=""
QUIT
Begin DoDot:3
+17 SET PROC=""
+18 FOR
SET PROC=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC))
if PROC=""
QUIT
Begin DoDot:4
+19 SET SPEC=""
+20 FOR
SET SPEC=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC))
if SPEC=""
QUIT
Begin DoDot:5
+21 SET ORIG=""
+22 FOR
SET ORIG=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG))
if ORIG=""
QUIT
DO SPEC1
if FQUIT
QUIT
End DoDot:5
if FQUIT
QUIT
+23 QUIT
End DoDot:4
if FQUIT
QUIT
+24 QUIT
End DoDot:3
if FQUIT
QUIT
+25 QUIT
End DoDot:2
if FQUIT
QUIT
+26 QUIT
End DoDot:1
if FQUIT
QUIT
+27 QUIT
+28 ;
SPEC1 ;
+1 SET NUPG=1
+2 SET DESC=""
+3 FOR
SET DESC=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC))
if DESC=""
QUIT
Begin DoDot:1
+4 SET PROCTXT=""
+5 FOR
SET PROCTXT=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT))
if PROCTXT=""
QUIT
Begin DoDot:2
+6 SET PARENT=""
+7 FOR
SET PARENT=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT))
if PARENT=""
QUIT
Begin DoDot:3
+8 SET DOCCAT=""
+9 FOR
SET DOCCAT=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT))
if DOCCAT=""
QUIT
Begin DoDot:4
+10 SET OBJTYP=""
+11 FOR
SET OBJTYP=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP))
if OBJTYP=""
QUIT
Begin DoDot:5
+12 SET SAVBYGRP=""
+13 FOR
SET SAVBYGRP=$ORDER(^TMP($JOB,"MAGIXCVSTAT",PKG,CLS,TYP,PROC,SPEC,ORIG,DESC,PROCTXT,PARENT,DOCCAT,OBJTYP,SAVBYGRP))
if SAVBYGRP=""
QUIT
SET KT=^(SAVBYGRP)
Begin DoDot:6
+14 ; count must exceed frequency threshold
IF KT<FRQTHRS
QUIT
+15 IF ($Y>(IOSL-3))!NUPG
DO ANZHED
if FQUIT
QUIT
+16 WRITE DESC," ",?34,PROCTXT," ",?64,PARENT," ",?78,DOCCAT," ",?92,OBJTYP," ",?106,SAVBYGRP," ",?150,$JUSTIFY(KT,8),!
+17 QUIT
End DoDot:6
if FQUIT
QUIT
+18 QUIT
End DoDot:5
if FQUIT
QUIT
+19 QUIT
End DoDot:4
if FQUIT
QUIT
+20 QUIT
End DoDot:3
if FQUIT
QUIT
+21 QUIT
End DoDot:2
if FQUIT
QUIT
+22 QUIT
End DoDot:1
if FQUIT
QUIT
+23 QUIT
+24 ;
ANZHED ;
+1 IF PG>0
IF IOT="TRM"!(IOT="VTRM")
Begin DoDot:1
+2 READ !!,"Press <RETURN> to continue, or '^' to exit: ",RET:DTIME
+3 SET FQUIT=(RET="^")
+4 QUIT
End DoDot:1
if FQUIT
QUIT
+5 SET PG=PG+1
SET NUPG=0
+6 WRITE #!,"Site: ",SUB
DO CTR("IMAGE INDEX GENERATION REPORT")
WRITE ?115,"DATE ",RDATE,!
+7 ;W "Range: ",RANGE
+8 DO CTR("Package: "_PKG)
+9 WRITE ?122,$JUSTIFY("PAGE "_PG,8),!
+10 DO CTR("Class: "_$SELECT(CLS:CLS_" - "_$PIECE($GET(^MAG(2005.82,CLS,0)),"^"),1:"(none)"))
WRITE !
+11 DO CTR("Type: "_$SELECT(TYP:TYP_" - "_$PIECE($GET(^MAG(2005.83,TYP,0)),"^"),1:"(none)"))
WRITE !
+12 DO CTR("Procedure/Event: "_$SELECT(PROC:PROC_" - "_$PIECE($GET(^MAG(2005.85,PROC,0)),"^"),1:"(none)"))
WRITE !
+13 DO CTR("Specialty: "_$SELECT(SPEC:SPEC_" - "_$PIECE($GET(^MAG(2005.84,SPEC,0)),"^"),1:"(none)"))
WRITE !
+14 DO CTR("Origin: "_ORIG)
WRITE !!
+15 WRITE ?64,"Parent",!
+16 WRITE "Short Description",?34,"Procedure Text",?64,"Data File",?78,"Document Cat",?92,"Object Type",?106,"Save By Group",?153,"Count",!!
+17 QUIT
+18 ;
CTR(X) WRITE ?65-($LENGTH(X)/2),X
QUIT
EOR ;END ROUTINE
