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

BLRLUAC2.m

Go to the documentation of this file. 
  1. BLRLUAC2 ;  IHS/OIT/MKK - IHS LRUPAC 2, reports ; [ 05/15/11  7:50 AM ]
  1.  ;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
  1.  ;;
  1.  ;; Emulates the Lab accession and test counts Report, Part 2
  1.  ;;
  1. EP ; EP - Menu of Reports
  1.  NEW LAB60IEN,L60DESC,LOOPER,SPECTYPE,SPECNAME
  1.  NEW HEADER,LINES,MAXLINES,PG,QFLG,HEDONE
  1.  NEW LRLDT,LRSDT,SELRAAAB,XTMPNODE
  1.  NEW DIRTRICK,ENDMSG
  1.  NEW BLRMMENU,BLRVERN
  1.  NEW DATETIME
  1.  ;
  1.  S DATETIME=-1
  1.  F  Q:DATETIME=0  D
  1.  . Q:$$GTIMEDT<1
  1.  . ;
  1.  . D OUTINITV               ; Initialize MENU variables
  1.  . D MENUDRFM^BLRGMENU("Lab accession and test counts","Report Selection")   ; Main Menu driver
  1.  . K BLRMMENU
  1.  ;
  1.  Q
  1.  ;
  1. OUTINITV ; EP -- Initialization of variables
  1.  S BLRVERN=$P($P($T(+1),";")," ")
  1.  D ADDTMENU^BLRGMENU("F61REPT^BLRLUAC6","Topography File Counts")
  1.  D ADDTMENU^BLRGMENU("F6160RPT^BLRLUAC4","Topography File & Laboratory Tests Counts")
  1.  D ADDTMENU^BLRGMENU("F60SREPT^BLRLUAC5","Laboratory Test Counts")
  1.  D ADDTMENU^BLRGMENU("F44REPT^BLRLUAC5","Location File Counts")
  1.  D ADDTMENU^BLRGMENU("F4460RPT^BLRLUAC3","Location File & Laboratory Tests Counts")
  1.  D ADDTMENU^BLRGMENU("FILE4RPT^BLRLUAC7","Institution File Counts")
  1.  D ADDTMENU^BLRGMENU("F460REPT^BLRLUAC7","Institution File & Laboratory Tests Counts")
  1.  D ADDTMENU^BLRGMENU("REPTERRC^BLRLUAC8","Compilation Errors")
  1.  ;
  1.  I $G(^VA(200,DUZ,0))'["KRING,MI" Q
  1.  D ADDTMENU^BLRGMENU("BLRRTNS^BLRLUAC2","BLR Routines That Emulate LRUPAC Routines")
  1.  Q
  1.  ;
  1. GTIMEDT() ; EP - Set the DATETIME variable
  1.  NEW ARR,CNT,COL,DASHER,DTT,EXTDTT,LRAADESC,OUTARRAY
  1.  NEW SELLRAA,SELSTR,SORTVAR,START,STOP,STR,VARIOUS,WIDE,WOT
  1.  ;
  1.  D ^XBFMK
  1.  S (DTT,CNT,COL,WIDE)=0,ARR=1,SELSTR=""
  1.  D SETARRAY
  1.  ;
  1.  D OUTHEAD
  1.  ;
  1.  I $D(WOT)<1 D  Q 0
  1.  . D HEADERDT^BLRGMENU
  1.  . W !,?4,"No Compiled Data exists.",!
  1.  . D PRESSKEY^BLRGMENU(9)
  1.  . S DATETIME=0
  1.  ;
  1.  S DATETIME=-1
  1.  F  Q:DATETIME>-1  D
  1.  . D HEADERDT^BLRGMENU
  1.  . D ^XBFMK
  1.  . S DIR(0)=SELSTR
  1.  . S DIR("A")="Enter Response (1-"_$O(WOT(""),-1)_")"
  1.  . S ARR=0,CNT=5
  1.  . F  S ARR=$O(VARIOUS(ARR))  Q:ARR=""  D
  1.  .. S DIR("L",CNT)=$G(VARIOUS(ARR))
  1.  .. S CNT=CNT+1
  1.  . S DIR("L",1)="Select one of the Date/Time Compilations below:"
  1.  . S DIR("L",2)=""
  1.  . S DIR("L",3)="            Compiled          Acc Area                Begin Date     End Date"
  1.  . S DIR("L",4)="         -------------------  "_DASHER_"----------     ----------"
  1.  . S DIR("L")=""
  1.  . D ^DIR
  1.  . ;
  1.  . I +$G(DIRUT) S DATETIME=0  Q
  1.  . ;
  1.  . S DATETIME=+$G(WOT(+$G(Y)))
  1.  ;
  1.  I DATETIME<1 Q 0
  1.  ;
  1.  Q 1
  1.  ;
  1. SETARRAY ; EP -- Setup selection array
  1.  F  S DTT=$O(^BLRLUPAC(DTT))  Q:DTT<1  D
  1.  . Q:$D(^BLRLUPAC(DTT,"COMPILED"))<1     ; If no data on COMPILED node, still compiling -- skip.
  1.  . ;
  1.  . S EXTDTT=$$UP^XLFSTR($$FMTE^XLFDT(DTT,"5MPZ"))
  1.  . S EXTDTT=$P(EXTDTT," ")_$J($P(EXTDTT," ",2,3),9)
  1.  . ;
  1.  . S SORTVAR=$O(^BLRLUPAC(DTT,"COMPILED"))
  1.  . S STR=$G(^BLRLUPAC(DTT,SORTVAR))
  1.  . S SELLRAA=$P(STR,"^")
  1.  . ;
  1.  . D FIND^DIC(68,,,,SELLRAA,,,,,"OUTARRAY")
  1.  . S LRAADESC=SELLRAA_" "_$G(OUTARRAY("DILIST",1,1))
  1.  . I $L(LRAADESC)>WIDE S WIDE=$L(LRAADESC)
  1.  . ;
  1.  . S START=$$FMTE^XLFDT($P(STR,"^",2),"5DZ")
  1.  . S STOP=$$FMTE^XLFDT($P(STR,"^",3),"5DZ")
  1.  . ;
  1.  . S CNT=CNT+1
  1.  . S COL=COL+1
  1.  . ;
  1.  . I CNT>1 S SELSTR=SELSTR_";"_CNT_":"
  1.  . I CNT<2 S SELSTR="SO^"_CNT_":"
  1.  . ;
  1.  . S ARR=ARR+1
  1.  . S STR=$J("",1)_$$LJ^XLFSTR(LRAADESC,24)_$$LJ^XLFSTR(START,15)_STOP
  1.  . S VARIOUS(ARR)=$J("",5)_$J(CNT,2)_") "_$$LJ^XLFSTR(EXTDTT,20)_STR
  1.  . S WOT(CNT)=DTT
  1.  . ;
  1.  ;
  1.  ; Dashes for widest Accession description
  1.  S DASHER=$$LJ^XLFSTR($TR($J("",WIDE)," ","-"),24)
  1.  Q
  1.  ;
  1. OUTHEAD ; EP -- Reset HEADER array & Display
  1.  K HEADER
  1.  S HEADER(1)="Lab Accession and Test Counts"
  1.  S HEADER(2)="Report Selection"
  1.  ;
  1.  Q
  1.  ;
  1. ENDLOOP ; EP -- User ENDs LOOP
  1.  S:+$G(DIRUT) ENDMSG="No Selection or FileMan Exit."
  1.  S:+$G(Y)<0 ENDMSG="Invalid Selection."
  1.  D PROGEND(ENDMSG)
  1.  S LOOPER="STOP"
  1.  Q
  1.  ;
  1. BADJUJU ; EP -- Should never get here, but, if a user does, it's BAD ... VERY BAD.
  1.  D PROGEND("EXTREMELY Invalid Input.")   ; Distinctive message.
  1.  S LOOPER="STOP"
  1.  Q
  1.  ;
  1. GETXTMPV(SORT,SELRAAB,LRSDT,LRLDT,BADMSG) ; EP -- Get data from ^BLRLUPAC( & set Variables
  1.  S STR=$G(^BLRLUPAC(DATETIME,SORT))
  1.  S SELRAAAB=$P(STR,"^")
  1.  S LRSDT=+$P(STR,"^",2)
  1.  S LRLDT=+$P(STR,"^",3)
  1.  ;
  1.  I $L(SELRAAAB)<1!(LRSDT<1)!(LRLDT<1) D  Q "Q"
  1.  . I $L($G(BADMSG))>0 D   ; If BADMSG string exists
  1.  .. W !!,?4,BADMSG,!
  1.  .. D PRESSKEY^BLRGMENU(9)
  1.  ;
  1.  Q "OK"
  1.  ;
  1. TOTALS(TOTAL) ; EP
  1.  W ?64,$TR($J("",11)," ","-")
  1.  W !
  1.  W ?14,"TOTALS"
  1.  W ?64,$J($FN(+$G(TOTAL),","),11)
  1.  W !
  1.  Q
  1.  ;
  1. HEADONE(HEDONE) ; EP 
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR("A")="One Header Line ONLY"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="YO"
  1.  D ^DIR
  1.  S HEDONE=$S(+$G(Y)=1:"YES",1:"NO")
  1.  ;
  1.  Q
  1.  ;
  1. HEADONE2(HEDONE) ; EP -- Don't put header before asking question
  1.  W !
  1.  D ^XBFMK
  1.  S DIR("A")="One Header Line ONLY"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="YO"
  1.  D ^DIR
  1.  S HEDONE=$S(+$G(Y)=1:"YES",1:"NO")
  1.  ;
  1.  Q
  1.  ;
  1. PROGEND(MSG) ; EP -- Routine Ends 
  1.  W !,?4,MSG,"  Routine Ends.",!
  1.  D PRESSKEY^BLRGMENU(9)
  1.  D V^LRU
  1.  Q
  1.  ;
  1. BLRRTNS ; EP - List ALL Routines that make up the BLR version of the LRUPAC series
  1.  NEW BLRVERN,BLRVERN2,CNT,HEADER,WOTRTNS
  1.  NEW DATETIME,RTN,RTNDESC,RTNLINES,RTNPATCH,RTNSIZE
  1.  ;
  1.  D BLRRTNSI
  1.  ;
  1.  D BLRRTNSR
  1.  Q
  1.  ;
  1. BLRRTNSI ; EP - Initialization
  1.  S BLRVERN=$TR($P($T(+1),";")," ")
  1.  S BLRVERN2="BLRRTNS"
  1.  ;
  1.  S HEADER(1)="IHS Laboratory"
  1.  S HEADER(2)="IHS Version of LRUPAC Series"
  1.  S HEADER(3)=" "
  1.  ;
  1.  S $E(HEADER(4),11)=$TR($$CJ^XLFSTR("@Last@Edit@",14)," @","= ")
  1.  S $E(HEADER(4),27)="%ZOSF"
  1.  S $E(HEADER(4),35)="#"
  1.  ;
  1.  S HEADER(5)="Routine"
  1.  S $E(HEADER(5),13)="Date"
  1.  S $E(HEADER(5),20)="Time"
  1.  S $E(HEADER(5),28)="Size"
  1.  S $E(HEADER(5),34)="Lns"
  1.  S $E(HEADER(5),38)="Ptch"
  1.  S $E(HEADER(5),44)="Line 1 Description"
  1.  ;
  1.  S CNT=0
  1.  Q
  1.  ;
  1. BLRRTNSR ; EP - Report
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  S RTN="BLRLUAC"
  1.  F  S RTN=$O(^ROUTINE(RTN))  Q:RTN=""!($E(RTN,1,7)'="BLRLUAC")  D
  1.  . D BLRRTNSL(RTN)
  1.  ;
  1.  W !,?4,"Number of routines = ",CNT,!
  1.  D PRESSKEY^BLRGMENU(10)
  1.  Q
  1.  ;
  1. BLRRTNSL(RTN) ; EP - Report
  1.  D BLRRTNSB(RTN)
  1.  ;
  1.  W $E(RTN,1,9)
  1.  W ?10,$TR($$HTE^XLFDT(DATETIME,"2MZ"),"@"," ")
  1.  W ?25,$J($FN(RTNSIZE,","),6)
  1.  W ?32,$J(RTNLINES,4)
  1.  W ?37,RTNPATCH
  1.  W ?43,$E(RTNDESC,1,(IOM-43))
  1.  W !
  1.  S CNT=CNT+1
  1.  Q
  1.  ;
  1. BLRRTNSB(RTN) ; EP - Breakout Data
  1.  S DATETIME=$G(^ROUTINE(RTN,0))
  1.  D JUSTSIZE(RTN,.RTNSIZE)
  1.  S RTNLINES=+$G(^ROUTINE(RTN,0,0))
  1.  ;
  1.  ; Routine Description
  1.  S RTNDESC=$P($G(^ROUTINE(RTN,0,1)),";",2)
  1.  I RTNDESC["-" S RTNDESC=$P(RTNDESC,"-",2,99)
  1.  S RTNDESC=$P($$TRIM^XLFSTR(RTNDESC,"L"," "),"[",1)
  1.  ;
  1.  S RTNPATCH=$P($P($G(^ROUTINE(RTN,0,2)),";",5),"*",3)
  1.  S RTNPATCH=$RE($P($RE(RTNPATCH),",",1))
  1.  Q
  1.  ;
  1. JUSTSIZE(RTN,Y) ; EP
  1.  NEW AZHL,AZHL0,G,XCNP
  1.  S G="NEW I ZL @X X ^%ZOSF(""SIZE"")"
  1.  S X=RTN
  1.  S (AZHL,X)=RTN
  1.  K Z
  1.  S (AZHL0,X)=AZHL
  1.  S DIF="^TMP($J,""Z"","
  1.  S XCNP=0
  1.  X "X ^%ZOSF(""LOAD""),G"
  1.  Q