- 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 Jan 18, 2025@03:11:58 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