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