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