- HLUCM004 ;CIOFO-O/LJA - HL7/Capacity Mgt API ;3/13/03 09:37
- ;;1.6;HEALTH LEVEL SEVEN;*88,103**;Oct 13, 1995
- ;
- LOOPU ; Loop thru ^TMP($J,"HLUCMSTORE","U") data. Full-screen view...
- N CT,DATA,EXCL,IEN772,IENPAR,INCL,IOINHI,IOINORM,RNOMSG,STOP,TYPE,X
- S X="IOINHI;IOINORM" D ENDR^%ZISS
- ;
- LOOPU1 KILL DATA,EXCL,INCL,IEN772,IENPAR,INCL,RNOMSG,STOP,TYPE
- W @IOF,$$CJ^XLFSTR("Display of ^TMP($J,""HLUCMSTORE"",""U"") Data",IOM)
- W !,$$REPEAT^XLFSTR("=",IOM)
- ;
- W !!,$$CJ^XLFSTR("Type Totals",IOM)
- W !,$$CJ^XLFSTR("--------------------------------",IOM)
- S TYPE=""
- F S TYPE=$O(^TMP($J,"HLUCMSTORE","T",TYPE)) Q:TYPE']"" D
- . S DATA=$G(^TMP($J,"HLUCMSTORE","T",TYPE))
- . W !,$$CJ^XLFSTR(TYPE_" "_DATA,IOM)
- ;
- W !!,"Enter text in messages to include and exclude..."
- W !
- D EXCL(.EXCL)
- W !
- D INCL(.INCL)
- ;
- R !!,"Restrict # messages: 999// ",RNOMSG:999
- S:RNOMSG']"" RNOMSG=999
- QUIT:RNOMSG'?1.N ;->
- ;
- S (CT,CT(1))=0,IENPAR=0,STOP=0
- F S IENPAR=$O(^TMP($J,"HLUCMSTORE","U",IENPAR)) Q:'IENPAR!(STOP) D
- . S CT(1)=CT(1)+1
- . QUIT:'$$OK(+IENPAR,RNOMSG,.EXCL,.INCL) ;->
- . S CT=CT+1
- . D SHOWU(+IENPAR,"FULL")
- . R X:999 I X[U S STOP=1
- ;
- I CT(1)'>0 W !!,"No data exists..." H 2
- ;
- I CT(1)>0 D
- . W !!,$S('CT:"No matching entries found...",1:"#"_CT_" matching entries displayed...")
- . S CT=CT(1)-CT W !,"#"_CT_" entries skipped..."
- ;
- Q
- ;
- OK(IENPAR,RNOMSG,EXCL,INCL) ; Exclude and INcludes..
- N DATA,FAIL,HOLDEXCL,IEN772,NUM
- ;
- ; Count messages...
- S NUM=0,IEN772=0
- F S IEN772=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,IEN772)) Q:'IEN772 D
- . S NUM=NUM+1
- ;
- ; Quit if number messages in unit isn't right...
- I RNOMSG=999 QUIT:NUM>RNOMSG "" ;-> Should never happen!
- I RNOMSG'=999 QUIT:NUM'=RNOMSG "" ;->
- ;
- ; Parent node check...
- S DATA=$G(^TMP($J,"HLUCMSTORE","U",+IENPAR))
- ;
- ; Exclusions...
- QUIT:$$HOLDEXCL(DATA,.EXCL) "" ;->
- ;
- ; Child nodes check...
- I $O(EXCL(""))]"" D
- . S IEN772=0,HOLDEXCL=0
- . F S IEN772=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,IEN772)) Q:'IEN772!(HOLDEXCL) D
- . . S DATA=$$DATA(+IEN772)
- . . S HOLDEXCL=$$HOLDEXCL(DATA,.EXCL)
- ;
- QUIT:$G(HOLDEXCL) "" ;->
- ;
- ; Quit, if no INCLUDES...
- QUIT:$O(INCL(""))']"" 1 ;->
- ;
- ; Inclusion check for parent node...
- QUIT:$$HOLDINCL(DATA,.INCL) 1 ;->
- ;
- ; Child node inclusion checks...
- S IEN772=0,HOLDINCL=0
- F S IEN772=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,IEN772)) Q:'IEN772!(HOLDINCL) D
- . S DATA=$$DATA(+IEN772)
- . S HOLDINCL=$$HOLDINCL(DATA,.INCL)
- ;
- Q HOLDINCL
- ;
- EXCL(EXCL) ; What entries to exclude? (Searches PARENT node)
- W !!,"Every parent node that includes one of the EXCLUDE values that you enter now"
- W !,"will not be included in the entries displayed."
- W !
- D ASK("EXCLUDE",.EXCL)
- Q
- ;
- HOLDEXCL(DATA,EXCL) ; Includes text that should be excluded?
- N HOLD
- S EXCL="",HOLD=0
- F S EXCL=$O(EXCL(EXCL)) Q:EXCL']""!(HOLD) D
- . I DATA[EXCL S HOLD=1
- Q HOLD
- ;
- INCL(INCL) ; What entries to include? (Searches PARENT node)
- W !!,"Every parent node that doesn't include one of the INCLUDE values that you"
- W !,"enter now will not be included in the entries displayed."
- W !
- D ASK("INCLUDE",.INCL)
- Q
- ;
- HOLDINCL(DATA,INCL) ; Does DATA hold one of the INCLUDEs?
- N HOLD
- S INCL="",HOLD=0
- F S INCL=$O(INCL(INCL)) Q:INCL']""!(HOLD) D
- . I DATA[INCL S HOLD=1
- Q HOLD
- ;
- ASK(TYPE,ENTRY) ; Repeatedly ask...
- N ANS
- F D QUIT:ANS']""
- . W !,TYPE,": "
- . R ANS:999 S:ANS=U ANS="" Q:ANS']"" ;->
- . S ENTRY(ANS)=""
- Q
- ;
- SHOWU(IENPAR,VIEW) ; Show one entry in VIEW format...
- N HL,X
- MERGE HL=^TMP($J,"HLUCMSTORE","U",+IENPAR)
- S X="D "_VIEW_"(.HL)" X X
- Q
- ;
- FULL(HL) ; Display one entry in FULL format...
- ; IOINHI,IOINORM -- req
- N COUNT,DATA,DATA4,DATAN,DATAP,DATAR,IEN772,L,LEN
- N PNO,PROTP,PROTC,RES,STOP
- ;
- ; Header...
- W @IOF
- S DATA=HL
- F D Q:DATA']""
- . W !,$$CJ^XLFSTR($E(DATA,1,70),IOM)
- . S DATA=$E(DATA,71,999)
- W !,$$REPEAT^XLFSTR("=",IOM)
- ;
- S PROTP=$P(HL,U,7)
- ;
- ; Body...
- S COUNT=0,IEN772=0,STOP=0
- F S IEN772=$O(HL(IEN772)) Q:'IEN772!(STOP) D
- . S COUNT=COUNT+1
- . S DATA=$$DATA(+IEN772)
- . S L=$L(DATA),X=$E(DATA,L-2,L) I X?3U,X'="CCC" S DATA=$E(DATA,1,L-3)_IOINHI_X_IOINORM
- . S PROTC=$P(DATA,U,7)
- . S $P(DATA,U,7)=$S(PROTP=PROTC:"...",1:"~hi~"_PROTC_"~hi~")
- . W !,IEN772,?12,"-",?14
- . F PNO=1:1:$L(DATA,U) D
- . . S DATAP=$P(DATA,U,+PNO)
- . . S DATAN=$P(DATA,U,+PNO+1)
- . . I DATAP["~hi~" D
- . . . S DATAP=$P(DATAP,"~hi~",2),LEN=$L(DATAP)+1
- . . . S DATAP=IOINHI_DATAP_IOINORM
- . . E S LEN=$L(DATAP)+1
- . . S DATAP=DATAP_$S(DATAN]"":U,1:"")
- . . W:(IOM-$X-LEN)'>0 !,?14
- . . W DATAP
- . I '(COUNT#4) W " ",IOINHI,"<",IOINORM R X:120 I X[U S STOP=1
- . W !,$$REPEAT^XLFSTR($S($O(HL(IEN772)):"-",1:"="),IOM)
- ;
- ; Trailer...
- S RES="C"
- F S RES=$O(HL(RES)) Q:RES'?3U D
- . S DATAR=HL(RES)
- . W $$CJ^XLFSTR(RES_" - "_DATAR,IOM)
- ;
- Q
- ;
- DATA(IEN772) ; Return what is displayed...
- N DATA,IENPAR,RES
- S IENPAR=+$G(^TMP($J,"HLUCMSTORE","X",+IEN772)) QUIT:'IENPAR "" ;->
- S RES=$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,"")) ; CCC, CXC, etc
- S DATA=$G(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,RES))_" <<>> "_$G(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,RES,772))_" <<>> "_RES
- I $TR(DATA," <>","")']"" S DATA=""
- Q DATA
- ;
- XTMPGBL(SHOW) ; Display XTMP data totals?
- N ANS,API,BEG,COND,DATA,END,HOLD,NO,RUN,SVNO,TIME,XTMP
- ;
- S XTMP="HLUCM ",SHOW=+$G(SHOW),HOLD=0
- QUIT:$O(^XTMP(XTMP))'?1"HLUCM "7N ;->
- W !!,$$CJ^XLFSTR(" XTMP-stored Reports ",IOM),!,$$REPEAT^XLFSTR("=",IOM)
- W !,"#",?4,"Run-time",?20,"API Call"
- W !,$$REPEAT^XLFSTR("=",IOM)
- F S XTMP=$O(^XTMP(XTMP)) Q:XTMP'?1"HLUCM "7N D
- . S BEG=0
- . F S BEG=$O(^XTMP(XTMP,"P",BEG)) Q:'BEG D
- . . S END=0
- . . F S END=$O(^XTMP(XTMP,"P",BEG,END)) Q:'END D
- . . . S COND=""
- . . . F S COND=$O(^XTMP(XTMP,"P",BEG,END,COND)) Q:COND']"" D
- . . . . S DATA=$G(^XTMP(XTMP,"P",BEG,END,COND)) QUIT:DATA']"" ;->
- . . . . S SVNO=+DATA,TIME=$P(DATA,U,2) QUIT:TIME']"" ;->
- . . . . S DATA=$G(^XTMP(XTMP,"N",+SVNO)),API=$P(DATA,U,4)
- . . . . S HOLD=HOLD+1
- . . . . S HOLD(TIME,HOLD)=XTMP_U_SVNO_"~"_$E(TIME_" ",1,16)_$E("$$"_API_"("_BEG_","_END_",1,1,"""_COND_""",TOTALS,.ERR)",1,60)
- . . . . S RUN(+SVNO)=XTMP
- S TIME=0,HOLD=0
- F S TIME=$O(HOLD(TIME)) Q:'TIME D
- . S NO=0
- . F S NO=$O(HOLD(TIME,NO)) Q:NO'>0 D
- . . S DATA=HOLD(TIME,NO),XTMP=$P(DATA,U)
- . . S SVNO=$P($P(DATA,"~"),U,2),DATA=$P(DATA,"~",2,999)
- . . S HOLD=HOLD+1
- . . S HOLD("N",HOLD)=XTMP_U_SVNO
- . . W !,$E("#"_HOLD_" ",1,4),DATA
- ;
- QUIT:HOLD'>0 "" ;->
- ;
- W !!,"You may choose to print the totals report from stored XTMP data if you like."
- W !,"If so, enter the number of the XTMP report from above now. (Otherwise,"
- W !,"press RETURN.)"
- ;
- R !!,"Enter XTMP Report#: ",NO:999 Q:'$D(HOLD("N",+NO)) "" ;->
- S XTMP=$P(HOLD("N",+NO),U),SVNO=$P(HOLD("N",+NO),U,2)
- ;
- Q $NA(^XTMP(XTMP,"D",SVNO))
- ;
- EOR ; HLUCM004 - HL7/Capacity Mgt API ;3/13/03 09:37
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUCM004 7153 printed Jan 18, 2025@03:01:29 Page 2
- HLUCM004 ;CIOFO-O/LJA - HL7/Capacity Mgt API ;3/13/03 09:37
- +1 ;;1.6;HEALTH LEVEL SEVEN;*88,103**;Oct 13, 1995
- +2 ;
- LOOPU ; Loop thru ^TMP($J,"HLUCMSTORE","U") data. Full-screen view...
- +1 NEW CT,DATA,EXCL,IEN772,IENPAR,INCL,IOINHI,IOINORM,RNOMSG,STOP,TYPE,X
- +2 SET X="IOINHI;IOINORM"
- DO ENDR^%ZISS
- +3 ;
- LOOPU1 KILL DATA,EXCL,INCL,IEN772,IENPAR,INCL,RNOMSG,STOP,TYPE
- +1 WRITE @IOF,$$CJ^XLFSTR("Display of ^TMP($J,""HLUCMSTORE"",""U"") Data",IOM)
- +2 WRITE !,$$REPEAT^XLFSTR("=",IOM)
- +3 ;
- +4 WRITE !!,$$CJ^XLFSTR("Type Totals",IOM)
- +5 WRITE !,$$CJ^XLFSTR("--------------------------------",IOM)
- +6 SET TYPE=""
- +7 FOR
- SET TYPE=$ORDER(^TMP($JOB,"HLUCMSTORE","T",TYPE))
- if TYPE']""
- QUIT
- Begin DoDot:1
- +8 SET DATA=$GET(^TMP($JOB,"HLUCMSTORE","T",TYPE))
- +9 WRITE !,$$CJ^XLFSTR(TYPE_" "_DATA,IOM)
- End DoDot:1
- +10 ;
- +11 WRITE !!,"Enter text in messages to include and exclude..."
- +12 WRITE !
- +13 DO EXCL(.EXCL)
- +14 WRITE !
- +15 DO INCL(.INCL)
- +16 ;
- +17 READ !!,"Restrict # messages: 999// ",RNOMSG:999
- +18 if RNOMSG']""
- SET RNOMSG=999
- +19 ;->
- if RNOMSG'?1.N
- QUIT
- +20 ;
- +21 SET (CT,CT(1))=0
- SET IENPAR=0
- SET STOP=0
- +22 FOR
- SET IENPAR=$ORDER(^TMP($JOB,"HLUCMSTORE","U",IENPAR))
- if 'IENPAR!(STOP)
- QUIT
- Begin DoDot:1
- +23 SET CT(1)=CT(1)+1
- +24 ;->
- if '$$OK(+IENPAR,RNOMSG,.EXCL,.INCL)
- QUIT
- +25 SET CT=CT+1
- +26 DO SHOWU(+IENPAR,"FULL")
- +27 READ X:999
- IF X[U
- SET STOP=1
- End DoDot:1
- +28 ;
- +29 IF CT(1)'>0
- WRITE !!,"No data exists..."
- HANG 2
- +30 ;
- +31 IF CT(1)>0
- Begin DoDot:1
- +32 WRITE !!,$SELECT('CT:"No matching entries found...",1:"#"_CT_" matching entries displayed...")
- +33 SET CT=CT(1)-CT
- WRITE !,"#"_CT_" entries skipped..."
- End DoDot:1
- +34 ;
- +35 QUIT
- +36 ;
- OK(IENPAR,RNOMSG,EXCL,INCL) ; Exclude and INcludes..
- +1 NEW DATA,FAIL,HOLDEXCL,IEN772,NUM
- +2 ;
- +3 ; Count messages...
- +4 SET NUM=0
- SET IEN772=0
- +5 FOR
- SET IEN772=$ORDER(^TMP($JOB,"HLUCMSTORE","U",+IENPAR,IEN772))
- if 'IEN772
- QUIT
- Begin DoDot:1
- +6 SET NUM=NUM+1
- End DoDot:1
- +7 ;
- +8 ; Quit if number messages in unit isn't right...
- +9 ;-> Should never happen!
- IF RNOMSG=999
- if NUM>RNOMSG
- QUIT ""
- +10 ;->
- IF RNOMSG'=999
- if NUM'=RNOMSG
- QUIT ""
- +11 ;
- +12 ; Parent node check...
- +13 SET DATA=$GET(^TMP($JOB,"HLUCMSTORE","U",+IENPAR))
- +14 ;
- +15 ; Exclusions...
- +16 ;->
- if $$HOLDEXCL(DATA,.EXCL)
- QUIT ""
- +17 ;
- +18 ; Child nodes check...
- +19 IF $ORDER(EXCL(""))]""
- Begin DoDot:1
- +20 SET IEN772=0
- SET HOLDEXCL=0
- +21 FOR
- SET IEN772=$ORDER(^TMP($JOB,"HLUCMSTORE","U",+IENPAR,IEN772))
- if 'IEN772!(HOLDEXCL)
- QUIT
- Begin DoDot:2
- +22 SET DATA=$$DATA(+IEN772)
- +23 SET HOLDEXCL=$$HOLDEXCL(DATA,.EXCL)
- End DoDot:2
- End DoDot:1
- +24 ;
- +25 ;->
- if $GET(HOLDEXCL)
- QUIT ""
- +26 ;
- +27 ; Quit, if no INCLUDES...
- +28 ;->
- if $ORDER(INCL(""))']""
- QUIT 1
- +29 ;
- +30 ; Inclusion check for parent node...
- +31 ;->
- if $$HOLDINCL(DATA,.INCL)
- QUIT 1
- +32 ;
- +33 ; Child node inclusion checks...
- +34 SET IEN772=0
- SET HOLDINCL=0
- +35 FOR
- SET IEN772=$ORDER(^TMP($JOB,"HLUCMSTORE","U",+IENPAR,IEN772))
- if 'IEN772!(HOLDINCL)
- QUIT
- Begin DoDot:1
- +36 SET DATA=$$DATA(+IEN772)
- +37 SET HOLDINCL=$$HOLDINCL(DATA,.INCL)
- End DoDot:1
- +38 ;
- +39 QUIT HOLDINCL
- +40 ;
- EXCL(EXCL) ; What entries to exclude? (Searches PARENT node)
- +1 WRITE !!,"Every parent node that includes one of the EXCLUDE values that you enter now"
- +2 WRITE !,"will not be included in the entries displayed."
- +3 WRITE !
- +4 DO ASK("EXCLUDE",.EXCL)
- +5 QUIT
- +6 ;
- HOLDEXCL(DATA,EXCL) ; Includes text that should be excluded?
- +1 NEW HOLD
- +2 SET EXCL=""
- SET HOLD=0
- +3 FOR
- SET EXCL=$ORDER(EXCL(EXCL))
- if EXCL']""!(HOLD)
- QUIT
- Begin DoDot:1
- +4 IF DATA[EXCL
- SET HOLD=1
- End DoDot:1
- +5 QUIT HOLD
- +6 ;
- INCL(INCL) ; What entries to include? (Searches PARENT node)
- +1 WRITE !!,"Every parent node that doesn't include one of the INCLUDE values that you"
- +2 WRITE !,"enter now will not be included in the entries displayed."
- +3 WRITE !
- +4 DO ASK("INCLUDE",.INCL)
- +5 QUIT
- +6 ;
- HOLDINCL(DATA,INCL) ; Does DATA hold one of the INCLUDEs?
- +1 NEW HOLD
- +2 SET INCL=""
- SET HOLD=0
- +3 FOR
- SET INCL=$ORDER(INCL(INCL))
- if INCL']""!(HOLD)
- QUIT
- Begin DoDot:1
- +4 IF DATA[INCL
- SET HOLD=1
- End DoDot:1
- +5 QUIT HOLD
- +6 ;
- ASK(TYPE,ENTRY) ; Repeatedly ask...
- +1 NEW ANS
- +2 FOR
- Begin DoDot:1
- +3 WRITE !,TYPE,": "
- +4 ;->
- READ ANS:999
- if ANS=U
- SET ANS=""
- if ANS']""
- QUIT
- +5 SET ENTRY(ANS)=""
- End DoDot:1
- if ANS']""
- QUIT
- +6 QUIT
- +7 ;
- SHOWU(IENPAR,VIEW) ; Show one entry in VIEW format...
- +1 NEW HL,X
- +2 MERGE HL=^TMP($JOB,"HLUCMSTORE","U",+IENPAR)
- +3 SET X="D "_VIEW_"(.HL)"
- XECUTE X
- +4 QUIT
- +5 ;
- FULL(HL) ; Display one entry in FULL format...
- +1 ; IOINHI,IOINORM -- req
- +2 NEW COUNT,DATA,DATA4,DATAN,DATAP,DATAR,IEN772,L,LEN
- +3 NEW PNO,PROTP,PROTC,RES,STOP
- +4 ;
- +5 ; Header...
- +6 WRITE @IOF
- +7 SET DATA=HL
- +8 FOR
- Begin DoDot:1
- +9 WRITE !,$$CJ^XLFSTR($EXTRACT(DATA,1,70),IOM)
- +10 SET DATA=$EXTRACT(DATA,71,999)
- End DoDot:1
- if DATA']""
- QUIT
- +11 WRITE !,$$REPEAT^XLFSTR("=",IOM)
- +12 ;
- +13 SET PROTP=$PIECE(HL,U,7)
- +14 ;
- +15 ; Body...
- +16 SET COUNT=0
- SET IEN772=0
- SET STOP=0
- +17 FOR
- SET IEN772=$ORDER(HL(IEN772))
- if 'IEN772!(STOP)
- QUIT
- Begin DoDot:1
- +18 SET COUNT=COUNT+1
- +19 SET DATA=$$DATA(+IEN772)
- +20 SET L=$LENGTH(DATA)
- SET X=$EXTRACT(DATA,L-2,L)
- IF X?3U
- IF X'="CCC"
- SET DATA=$EXTRACT(DATA,1,L-3)_IOINHI_X_IOINORM
- +21 SET PROTC=$PIECE(DATA,U,7)
- +22 SET $PIECE(DATA,U,7)=$SELECT(PROTP=PROTC:"...",1:"~hi~"_PROTC_"~hi~")
- +23 WRITE !,IEN772,?12,"-",?14
- +24 FOR PNO=1:1:$LENGTH(DATA,U)
- Begin DoDot:2
- +25 SET DATAP=$PIECE(DATA,U,+PNO)
- +26 SET DATAN=$PIECE(DATA,U,+PNO+1)
- +27 IF DATAP["~hi~"
- Begin DoDot:3
- +28 SET DATAP=$PIECE(DATAP,"~hi~",2)
- SET LEN=$LENGTH(DATAP)+1
- +29 SET DATAP=IOINHI_DATAP_IOINORM
- End DoDot:3
- +30 IF '$TEST
- SET LEN=$LENGTH(DATAP)+1
- +31 SET DATAP=DATAP_$SELECT(DATAN]"":U,1:"")
- +32 if (IOM-$X-LEN)'>0
- WRITE !,?14
- +33 WRITE DATAP
- End DoDot:2
- +34 IF '(COUNT#4)
- WRITE " ",IOINHI,"<",IOINORM
- READ X:120
- IF X[U
- SET STOP=1
- +35 WRITE !,$$REPEAT^XLFSTR($SELECT($ORDER(HL(IEN772)):"-",1:"="),IOM)
- End DoDot:1
- +36 ;
- +37 ; Trailer...
- +38 SET RES="C"
- +39 FOR
- SET RES=$ORDER(HL(RES))
- if RES'?3U
- QUIT
- Begin DoDot:1
- +40 SET DATAR=HL(RES)
- +41 WRITE $$CJ^XLFSTR(RES_" - "_DATAR,IOM)
- End DoDot:1
- +42 ;
- +43 QUIT
- +44 ;
- DATA(IEN772) ; Return what is displayed...
- +1 NEW DATA,IENPAR,RES
- +2 ;->
- SET IENPAR=+$GET(^TMP($JOB,"HLUCMSTORE","X",+IEN772))
- if 'IENPAR
- QUIT ""
- +3 ; CCC, CXC, etc
- SET RES=$ORDER(^TMP($JOB,"HLUCMSTORE","U",+IENPAR,+IEN772,""))
- +4 SET DATA=$GET(^TMP($JOB,"HLUCMSTORE","U",+IENPAR,+IEN772,RES))_" <<>> "_$GET(^TMP($JOB,"HLUCMSTORE","U",+IENPAR,+IEN772,RES,772))_" <<>> "_RES
- +5 IF $TRANSLATE(DATA," <>","")']""
- SET DATA=""
- +6 QUIT DATA
- +7 ;
- XTMPGBL(SHOW) ; Display XTMP data totals?
- +1 NEW ANS,API,BEG,COND,DATA,END,HOLD,NO,RUN,SVNO,TIME,XTMP
- +2 ;
- +3 SET XTMP="HLUCM "
- SET SHOW=+$GET(SHOW)
- SET HOLD=0
- +4 ;->
- if $ORDER(^XTMP(XTMP))'?1"HLUCM "7N
- QUIT
- +5 WRITE !!,$$CJ^XLFSTR(" XTMP-stored Reports ",IOM),!,$$REPEAT^XLFSTR("=",IOM)
- +6 WRITE !,"#",?4,"Run-time",?20,"API Call"
- +7 WRITE !,$$REPEAT^XLFSTR("=",IOM)
- +8 FOR
- SET XTMP=$ORDER(^XTMP(XTMP))
- if XTMP'?1"HLUCM "7N
- QUIT
- Begin DoDot:1
- +9 SET BEG=0
- +10 FOR
- SET BEG=$ORDER(^XTMP(XTMP,"P",BEG))
- if 'BEG
- QUIT
- Begin DoDot:2
- +11 SET END=0
- +12 FOR
- SET END=$ORDER(^XTMP(XTMP,"P",BEG,END))
- if 'END
- QUIT
- Begin DoDot:3
- +13 SET COND=""
- +14 FOR
- SET COND=$ORDER(^XTMP(XTMP,"P",BEG,END,COND))
- if COND']""
- QUIT
- Begin DoDot:4
- +15 ;->
- SET DATA=$GET(^XTMP(XTMP,"P",BEG,END,COND))
- if DATA']""
- QUIT
- +16 ;->
- SET SVNO=+DATA
- SET TIME=$PIECE(DATA,U,2)
- if TIME']""
- QUIT
- +17 SET DATA=$GET(^XTMP(XTMP,"N",+SVNO))
- SET API=$PIECE(DATA,U,4)
- +18 SET HOLD=HOLD+1
- +19 SET HOLD(TIME,HOLD)=XTMP_U_SVNO_"~"_$EXTRACT(TIME_" ",1,16)_$EXTRACT("$$"_API_"("_BEG_","_END_",1,1,"""_COND_""",TOTALS,.ERR)",1,60)
- +20 SET RUN(+SVNO)=XTMP
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 SET TIME=0
- SET HOLD=0
- +22 FOR
- SET TIME=$ORDER(HOLD(TIME))
- if 'TIME
- QUIT
- Begin DoDot:1
- +23 SET NO=0
- +24 FOR
- SET NO=$ORDER(HOLD(TIME,NO))
- if NO'>0
- QUIT
- Begin DoDot:2
- +25 SET DATA=HOLD(TIME,NO)
- SET XTMP=$PIECE(DATA,U)
- +26 SET SVNO=$PIECE($PIECE(DATA,"~"),U,2)
- SET DATA=$PIECE(DATA,"~",2,999)
- +27 SET HOLD=HOLD+1
- +28 SET HOLD("N",HOLD)=XTMP_U_SVNO
- +29 WRITE !,$EXTRACT("#"_HOLD_" ",1,4),DATA
- End DoDot:2
- End DoDot:1
- +30 ;
- +31 ;->
- if HOLD'>0
- QUIT ""
- +32 ;
- +33 WRITE !!,"You may choose to print the totals report from stored XTMP data if you like."
- +34 WRITE !,"If so, enter the number of the XTMP report from above now. (Otherwise,"
- +35 WRITE !,"press RETURN.)"
- +36 ;
- +37 ;->
- READ !!,"Enter XTMP Report#: ",NO:999
- if '$DATA(HOLD("N",+NO))
- QUIT ""
- +38 SET XTMP=$PIECE(HOLD("N",+NO),U)
- SET SVNO=$PIECE(HOLD("N",+NO),U,2)
- +39 ;
- +40 QUIT $NAME(^XTMP(XTMP,"D",SVNO))
- +41 ;
- EOR ; HLUCM004 - HL7/Capacity Mgt API ;3/13/03 09:37