HLEVUTI0 ;O-OIFO/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
;
SENDATA ; Interactively asks for 772 entry and returns Mailman message...
;
N CT,IEN,IEN772,RECIP,SCRN,TXT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
;
D HDASK,EXASK
;
S SCRN=0
;
KILL ^TMP($J,"HLIEN"),^TMP($J,"HLMAIL")
;
S0 W !!,"The most recent 772 IEN is... ",$O(^HL(772,":"),-1)
W !
;
S1 F D I 'IEN772 Q:'$D(^TMP($J,"HLIEN")) W ! S X=$$YN^HLCSRPT4("Stop entering 772 IENs") W:'X ! Q:X
. S IEN772=$$ASK772 QUIT:IEN772'>0 ;->
. S ^TMP($J,"HLIEN",+IEN772)=""
;
S2 I '$D(^TMP($J,"HLIEN")) D QUIT ;->
. W " no entries selected..."
;
S3 W !
F D I RECIP']"" W ! S X=$$YN^HLCSRPT4("Stop entering recipients") W:'X ! Q:X
. S RECIP=$$FT("Enter RECIPIENT","O") QUIT:RECIP']"" ;->
. S XMY(RECIP)=""
. W " added..."
;
S4 I '$D(XMY) D I 'SCRN KILL ^TMP($J,"HLIEN") QUIT ;->
. W !!,"No recipients were entered. You may just display the data on-screen."
. W !
. S SCRN=$$YN^HLCSRPT4("Display to screen","Yes")
;
S5 W !
I 'SCRN QUIT:$$BTE^HLCSMON("Press RETURN to send message, or '^' to exit... ") ;->
;
I SCRN W @IOF
;
; Collect data...
S6 S IEN=0
F S IEN=$O(^TMP($J,"HLIEN",IEN)) Q:'IEN D
. S IEN(1)=0,TXT="Requested 772#: "_IEN_" ",CT=0
. F S IEN(1)=$O(^HLMA("B",+IEN,IEN(1))) Q:'IEN(1) D
. . S ^TMP($J,"HLIEN",IEN,IEN(1))=""
. . S CT=CT+1
. . S TXT=TXT_$S(CT=1:"[773 #s: ",1:",")_IEN(1)
. I CT>0 S TXT=TXT_"]"
. D ADD(TXT)
;
S7 D ADD(""),ADD($$CJ^XLFSTR(" Requested Data ",74,"="))
S IEN=0
F S IEN=$O(^TMP($J,"HLIEN",IEN)) Q:'IEN D
. D COLLECT^HLEVUTI1(IEN)
;
I SCRN D G SENDATA ;->
. W !
. S X=$$BTE^HLCSMON("Press RETURN to continue... ")
;
; Email message...
S XMTEXT="^TMP("_$J_",""HLMAIL"",",XMDUZ=DUZ
S X=$$SITE^VASITE,XMSUB="HL7 Data - "_$P(X,U,2)_" ["_$P(X,U,3)_"]"
;
S8 D ^XMD
;
S9 W " ",$S($G(XMZ):" msg# "_XMZ_"...",1:"no msg sent...")
;
KILL ^TMP($J,"HLIEN"),^TMP($J,"HLMAIL")
;
Q
;
ADD(TXT) D ADD^HLEVUTI1(TXT)
Q
;
ASK772() ; Ask user for IENs...
N CT,I773,IEN,POSX
ASK7721 S IEN=$$ASKNUM("Enter 772 IEN") QUIT:'IEN "" ;->
I $D(^HL(772,+IEN,0)),$O(^HLMA("B",IEN,0))>0 D
. W:$X>55 ! W " Adding 773s... "
. S POSX=$X
. S I773=0,CT=0
. F S I773=$O(^HLMA("B",+IEN,I773)) Q:'I773 D
. . S CT=CT+1
. . I ($X+$L(I773)+3)>IOM S CT=0 W !
. . W:$X<POSX ?POSX
. . W $S(CT>1:", ",1:"")
. . W I773
QUIT:$D(^HL(772,+IEN,0)) IEN ;->
W " entry not found..."
G ASK7721 ;->
;
FT(PMT,WAY,DEF,LF) ; Free-text DIR request...
N DIR,DIRUT,DTOUT,DUOUT,I,X,Y
F I=1:1:$G(LF) Q:($Y+3)>IOSL W !
S DIR(0)="F"_$G(WAY),DIR("A")=PMT
D ^DIR
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
Q Y
;
ASKNUM(PMT,DEF) ; Ask user for a number via DIR...
N DIR,DIRUT,DTOUT,DUOUT,IEN,X,Y
S DIR(0)="NOA^1:999999999999999999",DIR("A")=PMT_": "
I $G(DEF)]"",DEF=+DEF S DIR("B")=DEF
D ^DIR
QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) "" ;->
I $L(Y,773)=3,$P(Y,773,2)>0 D QUIT Y
. S IEN=$P(Y,773,2) ; 773 ien...
. S IEN=+$G(^HLMA(+IEN,0)) QUIT:'IEN ;->
. S Y=IEN
. W " selecting 772# ",IEN,"..."
Q +Y
;
HDASK W @IOF,$$CJ^XLFSTR("Send File 772 & 773 Data to Remote Recipient(s)",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
QUIT
;
EXASK N I,T F I=1:1 S T=$T(EXASK+I) QUIT:T'[";;" W !,$P(T,";;",2,99)
;;This utility collects data from the HL Message Text file (#772) and the
;;HL Message Administration file (#773) and forwards the data to local and
;;remote recipients.
;;
;;Before starting this utility you must know the file# 772 internal entry
;;number(s) (IEN). When data is collected for file# 772 entries you have
;;entered, any file# 773 data linked to the selected 772 entries will also be
;;automatically collected and included in the transmitted message.
QUIT
;
GENREP(GBLS,GBLR,NOSUB,SEQ) ; Generic report generator...
; GBLS = Global source...
; GBLR = Global report location...
; NOSUB = # subscript levels...
; --- Must be 2 to 4
; --- 1st subscript must be descriptive of problem, and <15 characters.
; It will be placed in a field of 15 characters.
; --- 2nd subscript must be descriptive of entry, and <15 characters.
; It will be placed in a field of 15 characters.
; If the 2nd subscript is the last subscript, entries at this level
; will be concatenated.
; --- Last subscript must identify entry, and will be concatenated.
; (See RECORD^HLEVX000 for example of data creation.)
; SEQ = Sequential & Numeric. 0/1
; --- If the last subscript is required to be numeric and sequential,
; (like the 870 in and out queues), then combine iens into range
; statements... eg, 25123-25131(#9)
;
; Stop all event monitoring to enable on-site debugging...
QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
;
S SEQ=+$G(SEQ)
;
; Make sure you don't return "leftovers" from before...
KILL @GBLR
;
; Checks...
QUIT:'$D(@GBLS)!($G(NOSUB)'>1) ;->
;
; Create header...
S TXT="List of problems" D STORE(0)
S TXT=$$REPEAT^XLFSTR("-",74) D STORE(0)
S TXT=""
;
; Setup & looping...
S PROBL="",TXT="",PNO=0
F S PROBL=$O(@GBLS@(PROBL)) Q:PROBL']"" D
. S PNO=PNO+1
. S TXT=$E(PROBL_$$REPEAT^XLFSTR(" ",15),1,15)
. S SUB2=""
. F S SUB2=$O(@GBLS@(PROBL,SUB2)) Q:SUB2']"" D
. . I NOSUB=2 D CONCAT($$SUBSTORE(PROBL,SUB2),15) QUIT ;->
. . S TXT=$E($E(TXT,1,15)_$E(SUB2,1,15)_$$REPEAT^XLFSTR(" ",30),1,30)
. . I SEQ,NOSUB=3 D CONDENSE(PROBL,SUB2)
. . S SUB3=""
. . F S SUB3=$O(@GBLS@(PROBL,SUB2,SUB3)) Q:SUB3']"" D
. . . I NOSUB=3 D CONCAT($$SUBSTORE(PROBL,SUB2,SUB3),30) QUIT ;->
. . . S TXT=$E($E(TXT,1,30)_$E(SUB3,1,30)_$$REPEAT^XLFSTR(" ",45),1,45)
. . . X "F I=$L(TXT):-1:1 Q:$E(TXT,I)'="" """ S POSX=I+2
. . . S TXT=$E(TXT_$$REPEAT^XLFSTR(" ",45),1,POSX)
. . . I SEQ,NOSUB=4 D CONDENSE(PROBL,SUB2,SUB3)
. . . S SUB4=""
. . . F S SUB4=$O(@GBLS@(PROBL,SUB2,SUB3,SUB4)) Q:SUB4']"" D
. . . . D CONCAT($$SUBSTORE(PROBL,SUB2,SUB3,SUB4),POSX)
. . . . ;Subscript limit!
. . . I TXT]"" D STORE(POSX)
. . I TXT]"" D STORE(30)
. I TXT]"" D STORE(15)
I TXT D STORE(0)
;
S TXT="" D STORE(0)
S TXT="Problem totals" D STORE(0)
S TXT=$$REPEAT^XLFSTR("-",74) D STORE(0)
;
S PROBL=""
F S PROBL=$O(@GBLS@(PROBL)) Q:PROBL']"" D
. S NUM=$G(@GBLS@(PROBL)) Q:NUM']"" ;->
. S TXT=$E(PROBL_$$REPEAT^XLFSTR(" ",15),1,15)_" #"_NUM
. D STORE(30)
;
Q
;
SUBSTORE(S1,S2,S3,S4) ; Should subscript be stored, or condensed value?
; GBLS -- req
N VAL
;
I $G(S4)]"" D QUIT S4 ;->
. S VAL=$G(@GBLS@(S1,S2,S3,S4)) QUIT:VAL']"" ;->
. S S4=VAL
;
I $G(S3)]"" D QUIT S3 ;->
. S VAL=$G(@GBLS@(S1,S2,S3)) QUIT:VAL']"" ;->
. S S3=VAL
;
I $G(S2)]"" D QUIT S2 ;->
. S VAL=$G(@GBLS@(S1,S2)) QUIT:VAL']"" ;->
. S S2=VAL
;
Q S2
;
CONDENSE(PROBL,SUB2,SUB3) ; Condense sequential numerics...
N DIFF,FIRST,GBL,IEN,LAST,NO
;
I $G(SUB3)']"" S GBL=$$COND2GBL(PROBL,SUB2)
I $G(SUB3)]"" S GBL=$$COND3GBL(PROBL,SUB2,SUB3)
;
S (FIRST,LAST)=$O(@GBL@(0)) Q:LAST'>0 ;->
S IEN=0
F S IEN=$O(@GBL@(IEN)) Q:'IEN D
.
. QUIT:IEN=LAST ;-> Must be first $O...
.
. ; If IEN isn't one more than the last IEN, seq string broken
. I IEN'=(LAST+1) D SEQBR
.
. ; Record the last IEN found...
. S LAST=IEN
;
; If the last entry is not one more # than the first entry...
I LAST'=(FIRST+1) D SEQBR
;
Q
;
SEQBR ; Sequence BRoken actions...
; FIRST,GBL,IEN,LAST -- req --> FIRST,@GBL[S] (reset)
N DIFF,VAL
S DIFF=LAST-FIRST+1 ; # IENs difference...
S VAL=FIRST_":"_LAST_"(#"_DIFF_")"
I (($L(LAST)*DIFF)+(DIFF))<$L(VAL) D QUIT ;-> No space savings
. S FIRST=IEN
S @GBL@(FIRST)=VAL
F NO=FIRST+1:1:LAST KILL @GBL@(NO)
S FIRST=IEN
Q
;
COND2GBL(PROBL,SUB2) ; Return global for NOSUB=2 looping...
; GBLS -- req
N GBL
S GBL=$E(GBLS,1,$L(GBLS)-1)_","_$$AQ(PROBL)_","_$$AQ(SUB2)_")"
Q GBL
;
COND3GBL(PROBL,SUB2,SUB3) ; Return global for NOSUM=3 looping...
; GBLS -- req
N GBL
S GBL=$E(GBLS,1,$L(GBLS)-1)_","_$$AQ(PROBL)_","_$$AQ(SUB2)_","_$$AQ(SUB3)_")"
Q GBL
;
AQ(VAL) ; Add quotes around non-numeric values...
QUIT:VAL=+VAL VAL ;-> Numeric...
QUIT """"_VAL_""""
;
CONCAT(VAL,PAD) ; Concatenate, separated w/commas, the VALs
; TXT -- req
I ($L(TXT)+$L(VAL)+1)>74 D STORE(PAD)
S TXT=TXT_$S($L(TXT)>PAD:",",1:"")_VAL
Q
;
STORE(PAD) ; Store data in @GBLR@ in report-ready format
; GBLR,TXT -- req
N NO
S NO=$O(@GBLR@(":"),-1)+1
S @GBLR@(+NO)=TXT
S TXT=$$REPEAT^XLFSTR(" ",PAD)
Q
;
EOR ;HLEVUTI0 - Event Monitor UTILITIES ;5/16/03 14:42
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLEVUTI0 8803 printed Oct 16, 2024@17:58:47 Page 2
HLEVUTI0 ;O-OIFO/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
+2 ;
SENDATA ; Interactively asks for 772 entry and returns Mailman message...
+1 ;
+2 NEW CT,IEN,IEN772,RECIP,SCRN,TXT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
+3 ;
+4 DO HDASK
DO EXASK
+5 ;
+6 SET SCRN=0
+7 ;
+8 KILL ^TMP($JOB,"HLIEN"),^TMP($JOB,"HLMAIL")
+9 ;
S0 WRITE !!,"The most recent 772 IEN is... ",$ORDER(^HL(772,":"),-1)
+1 WRITE !
+2 ;
S1 FOR
Begin DoDot:1
+1 ;->
SET IEN772=$$ASK772
if IEN772'>0
QUIT
+2 SET ^TMP($JOB,"HLIEN",+IEN772)=""
End DoDot:1
IF 'IEN772
if '$DATA(^TMP($JOB,"HLIEN"))
QUIT
WRITE !
SET X=$$YN^HLCSRPT4("Stop entering 772 IENs")
if 'X
WRITE !
if X
QUIT
+3 ;
S2 ;->
IF '$DATA(^TMP($JOB,"HLIEN"))
Begin DoDot:1
+1 WRITE " no entries selected..."
End DoDot:1
QUIT
+2 ;
S3 WRITE !
+1 FOR
Begin DoDot:1
+2 ;->
SET RECIP=$$FT("Enter RECIPIENT","O")
if RECIP']""
QUIT
+3 SET XMY(RECIP)=""
+4 WRITE " added..."
End DoDot:1
IF RECIP']""
WRITE !
SET X=$$YN^HLCSRPT4("Stop entering recipients")
if 'X
WRITE !
if X
QUIT
+5 ;
S4 ;->
IF '$DATA(XMY)
Begin DoDot:1
+1 WRITE !!,"No recipients were entered. You may just display the data on-screen."
+2 WRITE !
+3 SET SCRN=$$YN^HLCSRPT4("Display to screen","Yes")
End DoDot:1
IF 'SCRN
KILL ^TMP($JOB,"HLIEN")
QUIT
+4 ;
S5 WRITE !
+1 ;->
IF 'SCRN
if $$BTE^HLCSMON("Press RETURN to send message, or '^' to exit... ")
QUIT
+2 ;
+3 IF SCRN
WRITE @IOF
+4 ;
+5 ; Collect data...
S6 SET IEN=0
+1 FOR
SET IEN=$ORDER(^TMP($JOB,"HLIEN",IEN))
if 'IEN
QUIT
Begin DoDot:1
+2 SET IEN(1)=0
SET TXT="Requested 772#: "_IEN_" "
SET CT=0
+3 FOR
SET IEN(1)=$ORDER(^HLMA("B",+IEN,IEN(1)))
if 'IEN(1)
QUIT
Begin DoDot:2
+4 SET ^TMP($JOB,"HLIEN",IEN,IEN(1))=""
+5 SET CT=CT+1
+6 SET TXT=TXT_$SELECT(CT=1:"[773 #s: ",1:",")_IEN(1)
End DoDot:2
+7 IF CT>0
SET TXT=TXT_"]"
+8 DO ADD(TXT)
End DoDot:1
+9 ;
S7 DO ADD("")
DO ADD($$CJ^XLFSTR(" Requested Data ",74,"="))
+1 SET IEN=0
+2 FOR
SET IEN=$ORDER(^TMP($JOB,"HLIEN",IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 DO COLLECT^HLEVUTI1(IEN)
End DoDot:1
+4 ;
+5 ;->
IF SCRN
Begin DoDot:1
+6 WRITE !
+7 SET X=$$BTE^HLCSMON("Press RETURN to continue... ")
End DoDot:1
GOTO SENDATA
+8 ;
+9 ; Email message...
+10 SET XMTEXT="^TMP("_$JOB_",""HLMAIL"","
SET XMDUZ=DUZ
+11 SET X=$$SITE^VASITE
SET XMSUB="HL7 Data - "_$PIECE(X,U,2)_" ["_$PIECE(X,U,3)_"]"
+12 ;
S8 DO ^XMD
+1 ;
S9 WRITE " ",$SELECT($GET(XMZ):" msg# "_XMZ_"...",1:"no msg sent...")
+1 ;
+2 KILL ^TMP($JOB,"HLIEN"),^TMP($JOB,"HLMAIL")
+3 ;
+4 QUIT
+5 ;
ADD(TXT) DO ADD^HLEVUTI1(TXT)
+1 QUIT
+2 ;
ASK772() ; Ask user for IENs...
+1 NEW CT,I773,IEN,POSX
ASK7721 ;->
SET IEN=$$ASKNUM("Enter 772 IEN")
if 'IEN
QUIT ""
+1 IF $DATA(^HL(772,+IEN,0))
IF $ORDER(^HLMA("B",IEN,0))>0
Begin DoDot:1
+2 if $X>55
WRITE !
WRITE " Adding 773s... "
+3 SET POSX=$X
+4 SET I773=0
SET CT=0
+5 FOR
SET I773=$ORDER(^HLMA("B",+IEN,I773))
if 'I773
QUIT
Begin DoDot:2
+6 SET CT=CT+1
+7 IF ($X+$LENGTH(I773)+3)>IOM
SET CT=0
WRITE !
+8 if $X<POSX
WRITE ?POSX
+9 WRITE $SELECT(CT>1:", ",1:"")
+10 WRITE I773
End DoDot:2
End DoDot:1
+11 ;->
if $DATA(^HL(772,+IEN,0))
QUIT IEN
+12 WRITE " entry not found..."
+13 ;->
GOTO ASK7721
+14 ;
FT(PMT,WAY,DEF,LF) ; Free-text DIR request...
+1 NEW DIR,DIRUT,DTOUT,DUOUT,I,X,Y
+2 FOR I=1:1:$GET(LF)
if ($Y+3)>IOSL
QUIT
WRITE !
+3 SET DIR(0)="F"_$GET(WAY)
SET DIR("A")=PMT
+4 DO ^DIR
+5 ;->
if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT ""
+6 QUIT Y
+7 ;
ASKNUM(PMT,DEF) ; Ask user for a number via DIR...
+1 NEW DIR,DIRUT,DTOUT,DUOUT,IEN,X,Y
+2 SET DIR(0)="NOA^1:999999999999999999"
SET DIR("A")=PMT_": "
+3 IF $GET(DEF)]""
IF DEF=+DEF
SET DIR("B")=DEF
+4 DO ^DIR
+5 ;->
if $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT ""
+6 IF $LENGTH(Y,773)=3
IF $PIECE(Y,773,2)>0
Begin DoDot:1
+7 ; 773 ien...
SET IEN=$PIECE(Y,773,2)
+8 ;->
SET IEN=+$GET(^HLMA(+IEN,0))
if 'IEN
QUIT
+9 SET Y=IEN
+10 WRITE " selecting 772# ",IEN,"..."
End DoDot:1
QUIT Y
+11 QUIT +Y
+12 ;
HDASK WRITE @IOF,$$CJ^XLFSTR("Send File 772 & 773 Data to Remote Recipient(s)",IOM)
+1 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+2 QUIT
+3 ;
EXASK NEW I,T
FOR I=1:1
SET T=$TEXT(EXASK+I)
if T'[";;"
QUIT
WRITE !,$PIECE(T,";;",2,99)
+1 ;;This utility collects data from the HL Message Text file (#772) and the
+2 ;;HL Message Administration file (#773) and forwards the data to local and
+3 ;;remote recipients.
+4 ;;
+5 ;;Before starting this utility you must know the file# 772 internal entry
+6 ;;number(s) (IEN). When data is collected for file# 772 entries you have
+7 ;;entered, any file# 773 data linked to the selected 772 entries will also be
+8 ;;automatically collected and included in the transmitted message.
+9 QUIT
+10 ;
GENREP(GBLS,GBLR,NOSUB,SEQ) ; Generic report generator...
+1 ; GBLS = Global source...
+2 ; GBLR = Global report location...
+3 ; NOSUB = # subscript levels...
+4 ; --- Must be 2 to 4
+5 ; --- 1st subscript must be descriptive of problem, and <15 characters.
+6 ; It will be placed in a field of 15 characters.
+7 ; --- 2nd subscript must be descriptive of entry, and <15 characters.
+8 ; It will be placed in a field of 15 characters.
+9 ; If the 2nd subscript is the last subscript, entries at this level
+10 ; will be concatenated.
+11 ; --- Last subscript must identify entry, and will be concatenated.
+12 ; (See RECORD^HLEVX000 for example of data creation.)
+13 ; SEQ = Sequential & Numeric. 0/1
+14 ; --- If the last subscript is required to be numeric and sequential,
+15 ; (like the 870 in and out queues), then combine iens into range
+16 ; statements... eg, 25123-25131(#9)
+17 ;
+18 ; Stop all event monitoring to enable on-site debugging...
+19 ;->
if $GET(^TMP("HLEVFLAG",$JOB))["STOP"
QUIT
+20 ;
+21 SET SEQ=+$GET(SEQ)
+22 ;
+23 ; Make sure you don't return "leftovers" from before...
+24 KILL @GBLR
+25 ;
+26 ; Checks...
+27 ;->
if '$DATA(@GBLS)!($GET(NOSUB)'>1)
QUIT
+28 ;
+29 ; Create header...
+30 SET TXT="List of problems"
DO STORE(0)
+31 SET TXT=$$REPEAT^XLFSTR("-",74)
DO STORE(0)
+32 SET TXT=""
+33 ;
+34 ; Setup & looping...
+35 SET PROBL=""
SET TXT=""
SET PNO=0
+36 FOR
SET PROBL=$ORDER(@GBLS@(PROBL))
if PROBL']""
QUIT
Begin DoDot:1
+37 SET PNO=PNO+1
+38 SET TXT=$EXTRACT(PROBL_$$REPEAT^XLFSTR(" ",15),1,15)
+39 SET SUB2=""
+40 FOR
SET SUB2=$ORDER(@GBLS@(PROBL,SUB2))
if SUB2']""
QUIT
Begin DoDot:2
+41 ;->
IF NOSUB=2
DO CONCAT($$SUBSTORE(PROBL,SUB2),15)
QUIT
+42 SET TXT=$EXTRACT($EXTRACT(TXT,1,15)_$EXTRACT(SUB2,1,15)_$$REPEAT^XLFSTR(" ",30),1,30)
+43 IF SEQ
IF NOSUB=3
DO CONDENSE(PROBL,SUB2)
+44 SET SUB3=""
+45 FOR
SET SUB3=$ORDER(@GBLS@(PROBL,SUB2,SUB3))
if SUB3']""
QUIT
Begin DoDot:3
+46 ;->
IF NOSUB=3
DO CONCAT($$SUBSTORE(PROBL,SUB2,SUB3),30)
QUIT
+47 SET TXT=$EXTRACT($EXTRACT(TXT,1,30)_$EXTRACT(SUB3,1,30)_$$REPEAT^XLFSTR(" ",45),1,45)
+48 XECUTE "F I=$L(TXT):-1:1 Q:$E(TXT,I)'="" """
SET POSX=I+2
+49 SET TXT=$EXTRACT(TXT_$$REPEAT^XLFSTR(" ",45),1,POSX)
+50 IF SEQ
IF NOSUB=4
DO CONDENSE(PROBL,SUB2,SUB3)
+51 SET SUB4=""
+52 FOR
SET SUB4=$ORDER(@GBLS@(PROBL,SUB2,SUB3,SUB4))
if SUB4']""
QUIT
Begin DoDot:4
+53 DO CONCAT($$SUBSTORE(PROBL,SUB2,SUB3,SUB4),POSX)
+54 ;Subscript limit!
End DoDot:4
+55 IF TXT]""
DO STORE(POSX)
End DoDot:3
+56 IF TXT]""
DO STORE(30)
End DoDot:2
+57 IF TXT]""
DO STORE(15)
End DoDot:1
+58 IF TXT
DO STORE(0)
+59 ;
+60 SET TXT=""
DO STORE(0)
+61 SET TXT="Problem totals"
DO STORE(0)
+62 SET TXT=$$REPEAT^XLFSTR("-",74)
DO STORE(0)
+63 ;
+64 SET PROBL=""
+65 FOR
SET PROBL=$ORDER(@GBLS@(PROBL))
if PROBL']""
QUIT
Begin DoDot:1
+66 ;->
SET NUM=$GET(@GBLS@(PROBL))
if NUM']""
QUIT
+67 SET TXT=$EXTRACT(PROBL_$$REPEAT^XLFSTR(" ",15),1,15)_" #"_NUM
+68 DO STORE(30)
End DoDot:1
+69 ;
+70 QUIT
+71 ;
SUBSTORE(S1,S2,S3,S4) ; Should subscript be stored, or condensed value?
+1 ; GBLS -- req
+2 NEW VAL
+3 ;
+4 ;->
IF $GET(S4)]""
Begin DoDot:1
+5 ;->
SET VAL=$GET(@GBLS@(S1,S2,S3,S4))
if VAL']""
QUIT
+6 SET S4=VAL
End DoDot:1
QUIT S4
+7 ;
+8 ;->
IF $GET(S3)]""
Begin DoDot:1
+9 ;->
SET VAL=$GET(@GBLS@(S1,S2,S3))
if VAL']""
QUIT
+10 SET S3=VAL
End DoDot:1
QUIT S3
+11 ;
+12 ;->
IF $GET(S2)]""
Begin DoDot:1
+13 ;->
SET VAL=$GET(@GBLS@(S1,S2))
if VAL']""
QUIT
+14 SET S2=VAL
End DoDot:1
QUIT S2
+15 ;
+16 QUIT S2
+17 ;
CONDENSE(PROBL,SUB2,SUB3) ; Condense sequential numerics...
+1 NEW DIFF,FIRST,GBL,IEN,LAST,NO
+2 ;
+3 IF $GET(SUB3)']""
SET GBL=$$COND2GBL(PROBL,SUB2)
+4 IF $GET(SUB3)]""
SET GBL=$$COND3GBL(PROBL,SUB2,SUB3)
+5 ;
+6 ;->
SET (FIRST,LAST)=$ORDER(@GBL@(0))
if LAST'>0
QUIT
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(@GBL@(IEN))
if 'IEN
QUIT
Begin DoDot:1
+9 +10 ;-> Must be first $O...
if IEN=LAST
QUIT
+11 +12 ; If IEN isn't one more than the last IEN, seq string broken
+13 IF IEN'=(LAST+1)
DO SEQBR
+14 +15 ; Record the last IEN found...
+16 SET LAST=IEN
End DoDot:1
+17 ;
+18 ; If the last entry is not one more # than the first entry...
+19 IF LAST'=(FIRST+1)
DO SEQBR
+20 ;
+21 QUIT
+22 ;
SEQBR ; Sequence BRoken actions...
+1 ; FIRST,GBL,IEN,LAST -- req --> FIRST,@GBL[S] (reset)
+2 NEW DIFF,VAL
+3 ; # IENs difference...
SET DIFF=LAST-FIRST+1
+4 SET VAL=FIRST_":"_LAST_"(#"_DIFF_")"
+5 ;-> No space savings
IF (($LENGTH(LAST)*DIFF)+(DIFF))<$LENGTH(VAL)
Begin DoDot:1
+6 SET FIRST=IEN
End DoDot:1
QUIT
+7 SET @GBL@(FIRST)=VAL
+8 FOR NO=FIRST+1:1:LAST
KILL @GBL@(NO)
+9 SET FIRST=IEN
+10 QUIT
+11 ;
COND2GBL(PROBL,SUB2) ; Return global for NOSUB=2 looping...
+1 ; GBLS -- req
+2 NEW GBL
+3 SET GBL=$EXTRACT(GBLS,1,$LENGTH(GBLS)-1)_","_$$AQ(PROBL)_","_$$AQ(SUB2)_")"
+4 QUIT GBL
+5 ;
COND3GBL(PROBL,SUB2,SUB3) ; Return global for NOSUM=3 looping...
+1 ; GBLS -- req
+2 NEW GBL
+3 SET GBL=$EXTRACT(GBLS,1,$LENGTH(GBLS)-1)_","_$$AQ(PROBL)_","_$$AQ(SUB2)_","_$$AQ(SUB3)_")"
+4 QUIT GBL
+5 ;
AQ(VAL) ; Add quotes around non-numeric values...
+1 ;-> Numeric...
if VAL=+VAL
QUIT VAL
+2 QUIT """"_VAL_""""
+3 ;
CONCAT(VAL,PAD) ; Concatenate, separated w/commas, the VALs
+1 ; TXT -- req
+2 IF ($LENGTH(TXT)+$LENGTH(VAL)+1)>74
DO STORE(PAD)
+3 SET TXT=TXT_$SELECT($LENGTH(TXT)>PAD:",",1:"")_VAL
+4 QUIT
+5 ;
STORE(PAD) ; Store data in @GBLR@ in report-ready format
+1 ; GBLR,TXT -- req
+2 NEW NO
+3 SET NO=$ORDER(@GBLR@(":"),-1)+1
+4 SET @GBLR@(+NO)=TXT
+5 SET TXT=$$REPEAT^XLFSTR(" ",PAD)
+6 QUIT
+7 ;
EOR ;HLEVUTI0 - Event Monitor UTILITIES ;5/16/03 14:42
