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

MAGXCVS.m

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