- HLUCM ;CIOFO-O/LJA - HL7/Capacity Mgt API ;09/13/04 14:01
- ;;1.6;HEALTH LEVEL SEVEN;**79,88,103,114**;Oct 13, 1995
- ;
- QUIT
- ;
- CM(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Capacity management totals
- N NMSPTYPE,PROTYPE,RESULTS,SITENM
- I '$D(HLAPI) N HLAPI S HLAPI="CM"
- QUIT:'$$PREPARE^HLUCM001 "" ;->
- D KILLS^HLUCM009("START")
- S RESULTS=$P($$LOOP,U,1,3)
- D XTMP
- D KILLS^HLUCM009("END")
- KILL HLAPI
- Q RESULTS
- ;
- CMF(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Collect Remote Facility data - SYNC
- N HLAPI
- S HLAPI="CMF"
- Q $$CM(START,END,.PNMSP,.IEN101,TOTALS,COND,.ERRINFO)
- ;
- CM2(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Capacity management totals
- N NMSPTYPE,PROTYPE,RESULTS,SITENM
- I '$D(HLAPI) N HLAPI S HLAPI="CM2"
- QUIT:'$$PREPARE^HLUCM001 "" ;->
- D KILLS^HLUCM009("START")
- S RESULTS=$P($$LOOP,U,1,3) ; Counts are aggregate
- D XTMP
- D KILLS^HLUCM009("END")
- KILL HLAPI
- QUIT RESULTS
- ;
- CM2F(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Collect Remote Facility data - SYNC
- N HLAPI
- S HLAPI="CM2F"
- Q $$CM2(START,END,.PNMSP,.IEN101,TOTALS,COND,.ERRINFO)
- ;
- LOOP() ; Loop thru 772's .01... (Called from LOOP^HLUCM)
- N ANS,API,CHAR,COUNTED,CTDBG,CTPCKG,D0,DATA,DEF,ERR,FAC,FAIL,HL,HLASTNM
- N HLUCMADD,IEN772,IEN773,LEN,LOOP772,LOOPDT,NMSP,NUM,OK
- N ORIGETM,ORIGSTM,PCKG,PROT,PROTOCOL,QUES,SEC
- N SP,SUB,SVNO,TIMEP,TM772,TOT,V1,V2,VAL,VALUE,X,Y
- ;
- D LOAD
- D ADJTIME^HLUCM003
- D CMDBD
- D TOTALCM ; Already stored in X (no counted) or C (counted) subscripts...
- S RESULTS=$G(^TMP(TOTALS,$J))
- ;
- QUIT RESULTS
- ;
- CMDBD ; Create $$CM debug data...
- ; HLAPI,START,END -- req
- N DATA,IENPAR,IEN772,OKPP,S1,S2,S3,SUB,TOT,VALNMSP,VALPROT
- ;
- S API=$S($G(API)["CM2":1,1:0) ; Async=1, Sync=0
- ;
- S IENPAR=0
- F S IENPAR=$O(^TMP($J,"HLPARENT",IENPAR)) Q:'IENPAR D
- . S DATA=$G(^TMP($J,"HLPARENT",+IENPAR)) QUIT:DATA']"" ;->
- . S VALPROT=$P(DATA,U,7),VALNMSP=$P(DATA,U,9)
- . F S1="C","X" F S2="C","X" F S3="C","X" S TOT(S1_S2_S3)=0
- . S ^TMP($J,"HLUCMSTORE","U",+IENPAR)=DATA
- . S IEN772=0
- . F S IEN772=$O(^TMP($J,"HLPARENT",+IENPAR,IEN772)) Q:'IEN772 D
- . . S ^TMP($J,"HLUCMSTORE","X",+IEN772)=+IENPAR
- . . S (OKPP,OKPP(1))=$$PP(+IEN772)
- . . S OKPP=$S(OKPP=U:"X",1:"C")
- . . S OK=$$COLLSYNC(+IEN772,START,END) ; Outside time range?
- . . S SUB=$S(OK:"C",1:"X")
- . . S DATA=$P($G(^TMP($J,"HLCHILD",+IEN772)),"~",2,999) Q:DATA']"" ;->
- . . ; If # seconds exceeds 1799...
- . . S SUB=SUB_$S($P(DATA,U,3)>1799:"X",1:"C")_OKPP
- . . S:$P(DATA,U,7)']"" $P(DATA,U,7)=VALPROT
- . . S:$P(DATA,U,9)']"" $P(DATA,U,9)=VALNMSP
- . . S ^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,SUB)=DATA
- . . F I=1:1:3 S $P(TOT(SUB),U,I)=$P(TOT(SUB),U,I)+$P(DATA,U,I)
- . . S DATA=$G(^TMP($J,"HLPARENT",+IENPAR,+IEN772))
- . . S X=OKPP(1),$P(DATA,U,5)=$P(X,U),$P(DATA,U,6)=$P(X,U,2)
- . . S ^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,SUB,772)=DATA
- .
- . ; Position #1 C=Count (Message BEGIN is not before START)
- . ; X=Outside (Msg BEGIN is before START)
- . ; #2 C=Count (#Seconds<1800)
- . ; X=Greater (#Seconds>1799)
- . ; #3 C=Count (Protocol/Namespace match)
- . ; X=Mismatch (Protocol/Namespace mismatch)
- . F S1="C","X" F S2="C","X" F S3="C","X" S SUB=S1_S2_S3 D
- . . QUIT:$TR(TOT(SUB),"0^","")']"" ;->
- . . S ^TMP($J,"HLUCMSTORE","U",+IENPAR,SUB)=TOT(SUB)
- . .
- . . S TOT=$G(^TMP($J,"HLUCMSTORE","T",SUB))
- . . D UPTOT
- . . S ^TMP($J,"HLUCMSTORE","T",SUB)=TOT
- . .
- . . S ^TMP($J,"HLUCMSTORE","T",SUB,IENPAR)=TOT(SUB)
- . .
- . . S TOT=$G(^TMP($J,"HLUCMSTORE","T"))
- . . D UPTOT
- . . S ^TMP($J,"HLUCMSTORE","T")=TOT
- ;
- KILL ^TMP($J,"HLCHILD"),^TMP($J,"HLPARENT")
- ;
- Q
- ;
- UPTOT ; Up the totals...
- ; TOT,TOT(SUB) -- req
- S $P(TOT,U)=$P(TOT,U)+$P(TOT(SUB),U)
- S $P(TOT,U,2)=$P(TOT,U,2)+$P(TOT(SUB),U,2)
- S $P(TOT,U,3)=$P(TOT,U,3)+$P(TOT(SUB),U,3)
- Q
- ;
- PP(IEN772) ; Get store value for NMSP and PROT...
- N PCKG,PP,PROT,X
- S PP=$$PROTNMSP^HLUCM002(+IEN772)
- I $P(PP,U)']""!($P(PP,U,2)']"") QUIT U ;->
- S X=$P(PP,U),PROT=$S(X]"":X,1:"ZZZ")
- S X=$P(PP,U,2),PCKG=$S(X]"":X,1:"ZZZ")
- Q PROT_U_PCKG
- ;
- LOAD ; Load data (Called by $$CM, $$CM2, and all other APIs)
- ; START,END -- req
- N IEN772,LOOPDT,X
- S LOOPDT=START-.000001
- F S LOOPDT=$O(^HL(772,"B",LOOPDT)) Q:LOOPDT'>0!(LOOPDT>END) D
- . S IEN772=0
- . F S IEN772=$O(^HL(772,"B",LOOPDT,IEN772)) Q:IEN772'>0 D
- . . QUIT:'$$OK772(+IEN772) ;->
- . . S X=$$LOAD772S^HLUCM009(IEN772)
- Q
- ;
- TOTALCM ; Loop, total for $$CM...
- ; HLAPI -- req
- N IEN772,IENPAR
- S IENPAR=0
- F S IENPAR=$O(^TMP($J,"HLUCMSTORE","U",IENPAR)) Q:'IENPAR D
- . ; Don't count anything unless the entire unit is OK...
- . QUIT:$O(^TMP($J,"HLUCMSTORE","U",+IENPAR,"CCC"))]"" ;->
- . S IEN772=0,HLUCMADD=""
- . F S IEN772=$O(^TMP($J,"HLUCMSTORE","U",IENPAR,IEN772)) Q:'IEN772 D
- . . ;QUIT:'$D(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,"CCC")) ;->
- . . D COLLECT(+IENPAR,+IEN772)
- . . I HLAPI["CM2" S HLUCMADD="DON'T ADD. COLLECT3~HLUCM003"
- Q
- ;
- COLLSYNC(IEN772,START,END) ; Does entry fall in START/END range?
- N DATA,X
- S DATA=$G(^TMP($J,"HLCHILD",+IEN772)) QUIT:DATA']"" "" ;->
- S X=$P($P(DATA,"~",2,999),U,4) Q:X'?7N.E!(X<START)!(X>END) "" ;->
- Q 1
- ;
- OK772(IEN772) ; Valid entry?
- N D
- S D=$G(^HL(772,+IEN772,0))
- QUIT:$P(D,U)'?7N.E "" ;->
- I $P(D,U,2)']"",$P(D,U,3)']"",$P(D,U,4)']"",$P(D,U,5)']"" QUIT ""
- Q 1
- ;
- COLLECT(PAR,IEN772) ; Collect 772 data and associated 773 data...
- N CT,CTPCKG,DATA,DBGBL,IEN773,PP,TOT772,TOT772T,TYPEHR,TYPEIO,TYPELR
- ;
- ; ^("U",PARENT-IEN,CHILD-IEN,"CCC")
- S DATA=$G(^TMP($J,"HLUCMSTORE","U",+PAR,+IEN772,"CCC"))
- S DATA("CHAR")=$P(DATA,U),DATA("DIFF")=$P(DATA,U,3)
- S DATA("START")=$P(DATA,U,4),DATA("END")=$P(DATA,U,5)
- S DATA("FAC")=$P(DATA,U,11)
- ;
- ; ^("U",PARENT-IEN,CHILD-IEN,"CCC",772)
- S DATA=$G(^TMP($J,"HLUCMSTORE","U",+PAR,+IEN772,"CCC",772))
- S DATA("HR")=$P(DATA,U),DATA("IO")=$P(DATA,U,2),DATA("LR")=$P(DATA,U,3)
- S (DATA("PROT"),PROT)=$P(DATA,U,5)
- S (DATA("PCKG"),PCKG)=$P(DATA,U,6)
- ;
- S DBGBL=1
- ;
- ; Store DATA() info in ^TMP(TOTALS,$J,...)
- D ADDTMP^HLUCM001
- ;
- QUIT
- ;
- TOT772C(IEN772) ; Total number of characters in message...
- N LEN,LNO,TXT
- ;
- ; Use field if present. (Not present about 25% of time)
- S LEN=$P($G(^HL(772,IEN772,"S")),U)
- I LEN D QUIT ;->
- . S DATA("CHAR",772)=$G(DATA("CHAR",772))+LEN
- . S DATA("CHAR")=$G(DATA("CHAR"))+LEN
- ;
- ; Total manually...
- S LNO=0
- F S LNO=$O(^HL(772,IEN772,"IN",LNO)) Q:LNO'>0 D
- . S TXT=$G(^HL(772,IEN772,"IN",+LNO,0)) QUIT:TXT']"" ;->
- . S DATA("CHAR",772)=$G(DATA("CHAR",772))+$L(TXT)
- . S DATA("CHAR")=$G(DATA("CHAR"))+$L(TXT)
- ;
- QUIT
- ;
- TOT772T(IEN772) ; Processing time...
- ; No totals here. Just set times in DATA() array for later use...
- N TIME
- ;
- ; Time of entry...
- S TIME=+$G(^HL(772,+IEN772,0))
- I TIME?7N.E S DATA("TIME",TIME,772,.01)=""
- ;
- ; Time processed...
- S TIME=$P($G(^HL(772,+IEN772,"P")),U,2)
- I TIME?7N.E S DATA("TIME",TIME,772,21)=""
- ;
- QUIT
- ;
- TOT773C(IEN773) ; Total number of characters...
- ; DATA() -- passed in (See COLLECT)
- N CHAR
- S CHAR=$$MSGSIZE(+IEN773) QUIT:CHAR'>0 ;->
- S DATA("CHAR",773,IEN773)=CHAR
- S DATA("CHAR")=$G(DATA("CHAR"))+CHAR
- S TOT773(IEN773)=CHAR
- QUIT
- ;
- MSGSIZE(IEN773) ; Number characters in 773 entry...
- N NCH,NO
- S NCH=0,NO=0
- F S NO=$O(^HLMA(+IEN773,"MSH",NO)) Q:NO'>0 D
- . S NCH=NCH+$L($G(^HLMA(+IEN773,"MSH",+NO,0)))
- QUIT NCH
- ;
- TOT773T(IEN773) ; Set TIMEs...
- ; DATA() -- passed in (See COLLECT)
- N TIME
- ;
- ; Creation time already taken from 772...
- ;
- ; Processed time...
- S TIME=+$G(^HLMA(+IEN773,"S")) QUIT:TIME'>0 ;->
- S DATA("TIME",TIME,773,100)=""
- ;
- QUIT
- ;
- ERR(REA) ; Record error...
- S NOERR=NOERR+1
- S REA=$S($G(REA)]"":REA,1:"?")
- S ERRINFO(REA)=""
- QUIT
- ;
- SEC(FMDT) ;
- S FMDT=$$FMTH^XLFDT(FMDT)
- QUIT $$SEC^XLFDT(FMDT)
- ;
- TMDIFF ; DATA("TIME",...) -- req --> DATA("DIFF")
- S (DATA("DIFF"),DATA("END"),DATA("START"))="" ; Default... HL*1.6*114
- S DATA("START")=$O(DATA("TIME",0)) QUIT:DATA("START")'>0 ;->
- S DATA("END")=$O(DATA("TIME",":"),-1)
- S DATA("DIFF")=$$SEC(DATA("END"))-$$SEC(DATA("START"))
- QUIT
- ;
- XTMP ; Store in ^XTMP...
- ; API Parameters -- req
- N XTMP
- ;
- QUIT:PNMSP'=1!(IEN101'=1) ;-> Must be ALL,ALL
- ;
- S XTMP="HLUCM "_$$DT^XLFDT
- S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT($$DT^XLFDT,7)_U_$$NOW^XLFDT_U_"HLUCM Data"
- ;
- S SVNO=$G(^XTMP(XTMP,"P",+START,+END,COND))
- I SVNO'>0 S SVNO=$O(^XTMP(XTMP,"N",":"),-1)+1
- S ^XTMP(XTMP,"P",+START,+END,COND)=SVNO_U_$$NOW^XLFDT
- S ^XTMP(XTMP,"N",+SVNO)=START_U_END_U_COND_U_HLAPI
- KILL ^XTMP(XTMP,"D",+SVNO)
- ;
- MERGE ^XTMP(XTMP,"D",+SVNO)=^TMP(TOTALS,$J)
- ;
- Q
- ;
- EOR ; HLUCM - HL7/Capacity Mgt API ;2/27/01 10:15
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUCM 8916 printed Feb 18, 2025@23:26:34 Page 2
- HLUCM ;CIOFO-O/LJA - HL7/Capacity Mgt API ;09/13/04 14:01
- +1 ;;1.6;HEALTH LEVEL SEVEN;**79,88,103,114**;Oct 13, 1995
- +2 ;
- +3 QUIT
- +4 ;
- CM(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Capacity management totals
- +1 NEW NMSPTYPE,PROTYPE,RESULTS,SITENM
- +2 IF '$DATA(HLAPI)
- NEW HLAPI
- SET HLAPI="CM"
- +3 ;->
- if '$$PREPARE^HLUCM001
- QUIT ""
- +4 DO KILLS^HLUCM009("START")
- +5 SET RESULTS=$PIECE($$LOOP,U,1,3)
- +6 DO XTMP
- +7 DO KILLS^HLUCM009("END")
- +8 KILL HLAPI
- +9 QUIT RESULTS
- +10 ;
- CMF(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Collect Remote Facility data - SYNC
- +1 NEW HLAPI
- +2 SET HLAPI="CMF"
- +3 QUIT $$CM(START,END,.PNMSP,.IEN101,TOTALS,COND,.ERRINFO)
- +4 ;
- CM2(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Capacity management totals
- +1 NEW NMSPTYPE,PROTYPE,RESULTS,SITENM
- +2 IF '$DATA(HLAPI)
- NEW HLAPI
- SET HLAPI="CM2"
- +3 ;->
- if '$$PREPARE^HLUCM001
- QUIT ""
- +4 DO KILLS^HLUCM009("START")
- +5 ; Counts are aggregate
- SET RESULTS=$PIECE($$LOOP,U,1,3)
- +6 DO XTMP
- +7 DO KILLS^HLUCM009("END")
- +8 KILL HLAPI
- +9 QUIT RESULTS
- +10 ;
- CM2F(START,END,PNMSP,IEN101,TOTALS,COND,ERRINFO) ; Collect Remote Facility data - SYNC
- +1 NEW HLAPI
- +2 SET HLAPI="CM2F"
- +3 QUIT $$CM2(START,END,.PNMSP,.IEN101,TOTALS,COND,.ERRINFO)
- +4 ;
- LOOP() ; Loop thru 772's .01... (Called from LOOP^HLUCM)
- +1 NEW ANS,API,CHAR,COUNTED,CTDBG,CTPCKG,D0,DATA,DEF,ERR,FAC,FAIL,HL,HLASTNM
- +2 NEW HLUCMADD,IEN772,IEN773,LEN,LOOP772,LOOPDT,NMSP,NUM,OK
- +3 NEW ORIGETM,ORIGSTM,PCKG,PROT,PROTOCOL,QUES,SEC
- +4 NEW SP,SUB,SVNO,TIMEP,TM772,TOT,V1,V2,VAL,VALUE,X,Y
- +5 ;
- +6 DO LOAD
- +7 DO ADJTIME^HLUCM003
- +8 DO CMDBD
- +9 ; Already stored in X (no counted) or C (counted) subscripts...
- DO TOTALCM
- +10 SET RESULTS=$GET(^TMP(TOTALS,$JOB))
- +11 ;
- +12 QUIT RESULTS
- +13 ;
- CMDBD ; Create $$CM debug data...
- +1 ; HLAPI,START,END -- req
- +2 NEW DATA,IENPAR,IEN772,OKPP,S1,S2,S3,SUB,TOT,VALNMSP,VALPROT
- +3 ;
- +4 ; Async=1, Sync=0
- SET API=$SELECT($GET(API)["CM2":1,1:0)
- +5 ;
- +6 SET IENPAR=0
- +7 FOR
- SET IENPAR=$ORDER(^TMP($JOB,"HLPARENT",IENPAR))
- if 'IENPAR
- QUIT
- Begin DoDot:1
- +8 ;->
- SET DATA=$GET(^TMP($JOB,"HLPARENT",+IENPAR))
- if DATA']""
- QUIT
- +9 SET VALPROT=$PIECE(DATA,U,7)
- SET VALNMSP=$PIECE(DATA,U,9)
- +10 FOR S1="C","X"
- FOR S2="C","X"
- FOR S3="C","X"
- SET TOT(S1_S2_S3)=0
- +11 SET ^TMP($JOB,"HLUCMSTORE","U",+IENPAR)=DATA
- +12 SET IEN772=0
- +13 FOR
- SET IEN772=$ORDER(^TMP($JOB,"HLPARENT",+IENPAR,IEN772))
- if 'IEN772
- QUIT
- Begin DoDot:2
- +14 SET ^TMP($JOB,"HLUCMSTORE","X",+IEN772)=+IENPAR
- +15 SET (OKPP,OKPP(1))=$$PP(+IEN772)
- +16 SET OKPP=$SELECT(OKPP=U:"X",1:"C")
- +17 ; Outside time range?
- SET OK=$$COLLSYNC(+IEN772,START,END)
- +18 SET SUB=$SELECT(OK:"C",1:"X")
- +19 ;->
- SET DATA=$PIECE($GET(^TMP($JOB,"HLCHILD",+IEN772)),"~",2,999)
- if DATA']""
- QUIT
- +20 ; If # seconds exceeds 1799...
- +21 SET SUB=SUB_$SELECT($PIECE(DATA,U,3)>1799:"X",1:"C")_OKPP
- +22 if $PIECE(DATA,U,7)']""
- SET $PIECE(DATA,U,7)=VALPROT
- +23 if $PIECE(DATA,U,9)']""
- SET $PIECE(DATA,U,9)=VALNMSP
- +24 SET ^TMP($JOB,"HLUCMSTORE","U",+IENPAR,+IEN772,SUB)=DATA
- +25 FOR I=1:1:3
- SET $PIECE(TOT(SUB),U,I)=$PIECE(TOT(SUB),U,I)+$PIECE(DATA,U,I)
- +26 SET DATA=$GET(^TMP($JOB,"HLPARENT",+IENPAR,+IEN772))
- +27 SET X=OKPP(1)
- SET $PIECE(DATA,U,5)=$PIECE(X,U)
- SET $PIECE(DATA,U,6)=$PIECE(X,U,2)
- +28 SET ^TMP($JOB,"HLUCMSTORE","U",+IENPAR,+IEN772,SUB,772)=DATA
- End DoDot:2
- +29 +30 ; Position #1 C=Count (Message BEGIN is not before START)
- +31 ; X=Outside (Msg BEGIN is before START)
- +32 ; #2 C=Count (#Seconds<1800)
- +33 ; X=Greater (#Seconds>1799)
- +34 ; #3 C=Count (Protocol/Namespace match)
- +35 ; X=Mismatch (Protocol/Namespace mismatch)
- +36 FOR S1="C","X"
- FOR S2="C","X"
- FOR S3="C","X"
- SET SUB=S1_S2_S3
- Begin DoDot:2
- +37 ;->
- if $TRANSLATE(TOT(SUB),"0^","")']""
- QUIT
- +38 SET ^TMP($JOB,"HLUCMSTORE","U",+IENPAR,SUB)=TOT(SUB)
- +39 +40 SET TOT=$GET(^TMP($JOB,"HLUCMSTORE","T",SUB))
- +41 DO UPTOT
- +42 SET ^TMP($JOB,"HLUCMSTORE","T",SUB)=TOT
- +43 +44 SET ^TMP($JOB,"HLUCMSTORE","T",SUB,IENPAR)=TOT(SUB)
- +45 +46 SET TOT=$GET(^TMP($JOB,"HLUCMSTORE","T"))
- +47 DO UPTOT
- +48 SET ^TMP($JOB,"HLUCMSTORE","T")=TOT
- End DoDot:2
- End DoDot:1
- +49 ;
- +50 KILL ^TMP($JOB,"HLCHILD"),^TMP($JOB,"HLPARENT")
- +51 ;
- +52 QUIT
- +53 ;
- UPTOT ; Up the totals...
- +1 ; TOT,TOT(SUB) -- req
- +2 SET $PIECE(TOT,U)=$PIECE(TOT,U)+$PIECE(TOT(SUB),U)
- +3 SET $PIECE(TOT,U,2)=$PIECE(TOT,U,2)+$PIECE(TOT(SUB),U,2)
- +4 SET $PIECE(TOT,U,3)=$PIECE(TOT,U,3)+$PIECE(TOT(SUB),U,3)
- +5 QUIT
- +6 ;
- PP(IEN772) ; Get store value for NMSP and PROT...
- +1 NEW PCKG,PP,PROT,X
- +2 SET PP=$$PROTNMSP^HLUCM002(+IEN772)
- +3 ;->
- IF $PIECE(PP,U)']""!($PIECE(PP,U,2)']"")
- QUIT U
- +4 SET X=$PIECE(PP,U)
- SET PROT=$SELECT(X]"":X,1:"ZZZ")
- +5 SET X=$PIECE(PP,U,2)
- SET PCKG=$SELECT(X]"":X,1:"ZZZ")
- +6 QUIT PROT_U_PCKG
- +7 ;
- LOAD ; Load data (Called by $$CM, $$CM2, and all other APIs)
- +1 ; START,END -- req
- +2 NEW IEN772,LOOPDT,X
- +3 SET LOOPDT=START-.000001
- +4 FOR
- SET LOOPDT=$ORDER(^HL(772,"B",LOOPDT))
- if LOOPDT'>0!(LOOPDT>END)
- QUIT
- Begin DoDot:1
- +5 SET IEN772=0
- +6 FOR
- SET IEN772=$ORDER(^HL(772,"B",LOOPDT,IEN772))
- if IEN772'>0
- QUIT
- Begin DoDot:2
- +7 ;->
- if '$$OK772(+IEN772)
- QUIT
- +8 SET X=$$LOAD772S^HLUCM009(IEN772)
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- TOTALCM ; Loop, total for $$CM...
- +1 ; HLAPI -- req
- +2 NEW IEN772,IENPAR
- +3 SET IENPAR=0
- +4 FOR
- SET IENPAR=$ORDER(^TMP($JOB,"HLUCMSTORE","U",IENPAR))
- if 'IENPAR
- QUIT
- Begin DoDot:1
- +5 ; Don't count anything unless the entire unit is OK...
- +6 ;->
- if $ORDER(^TMP($JOB,"HLUCMSTORE","U",+IENPAR,"CCC"))]""
- QUIT
- +7 SET IEN772=0
- SET HLUCMADD=""
- +8 FOR
- SET IEN772=$ORDER(^TMP($JOB,"HLUCMSTORE","U",IENPAR,IEN772))
- if 'IEN772
- QUIT
- Begin DoDot:2
- +9 ;QUIT:'$D(^TMP($J,"HLUCMSTORE","U",+IENPAR,+IEN772,"CCC")) ;->
- +10 DO COLLECT(+IENPAR,+IEN772)
- +11 IF HLAPI["CM2"
- SET HLUCMADD="DON'T ADD. COLLECT3~HLUCM003"
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ;
- COLLSYNC(IEN772,START,END) ; Does entry fall in START/END range?
- +1 NEW DATA,X
- +2 ;->
- SET DATA=$GET(^TMP($JOB,"HLCHILD",+IEN772))
- if DATA']""
- QUIT ""
- +3 ;->
- SET X=$PIECE($PIECE(DATA,"~",2,999),U,4)
- if X'?7N.E!(X<START)!(X>END)
- QUIT ""
- +4 QUIT 1
- +5 ;
- OK772(IEN772) ; Valid entry?
- +1 NEW D
- +2 SET D=$GET(^HL(772,+IEN772,0))
- +3 ;->
- if $PIECE(D,U)'?7N.E
- QUIT ""
- +4 IF $PIECE(D,U,2)']""
- IF $PIECE(D,U,3)']""
- IF $PIECE(D,U,4)']""
- IF $PIECE(D,U,5)']""
- QUIT ""
- +5 QUIT 1
- +6 ;
- COLLECT(PAR,IEN772) ; Collect 772 data and associated 773 data...
- +1 NEW CT,CTPCKG,DATA,DBGBL,IEN773,PP,TOT772,TOT772T,TYPEHR,TYPEIO,TYPELR
- +2 ;
- +3 ; ^("U",PARENT-IEN,CHILD-IEN,"CCC")
- +4 SET DATA=$GET(^TMP($JOB,"HLUCMSTORE","U",+PAR,+IEN772,"CCC"))
- +5 SET DATA("CHAR")=$PIECE(DATA,U)
- SET DATA("DIFF")=$PIECE(DATA,U,3)
- +6 SET DATA("START")=$PIECE(DATA,U,4)
- SET DATA("END")=$PIECE(DATA,U,5)
- +7 SET DATA("FAC")=$PIECE(DATA,U,11)
- +8 ;
- +9 ; ^("U",PARENT-IEN,CHILD-IEN,"CCC",772)
- +10 SET DATA=$GET(^TMP($JOB,"HLUCMSTORE","U",+PAR,+IEN772,"CCC",772))
- +11 SET DATA("HR")=$PIECE(DATA,U)
- SET DATA("IO")=$PIECE(DATA,U,2)
- SET DATA("LR")=$PIECE(DATA,U,3)
- +12 SET (DATA("PROT"),PROT)=$PIECE(DATA,U,5)
- +13 SET (DATA("PCKG"),PCKG)=$PIECE(DATA,U,6)
- +14 ;
- +15 SET DBGBL=1
- +16 ;
- +17 ; Store DATA() info in ^TMP(TOTALS,$J,...)
- +18 DO ADDTMP^HLUCM001
- +19 ;
- +20 QUIT
- +21 ;
- TOT772C(IEN772) ; Total number of characters in message...
- +1 NEW LEN,LNO,TXT
- +2 ;
- +3 ; Use field if present. (Not present about 25% of time)
- +4 SET LEN=$PIECE($GET(^HL(772,IEN772,"S")),U)
- +5 ;->
- IF LEN
- Begin DoDot:1
- +6 SET DATA("CHAR",772)=$GET(DATA("CHAR",772))+LEN
- +7 SET DATA("CHAR")=$GET(DATA("CHAR"))+LEN
- End DoDot:1
- QUIT
- +8 ;
- +9 ; Total manually...
- +10 SET LNO=0
- +11 FOR
- SET LNO=$ORDER(^HL(772,IEN772,"IN",LNO))
- if LNO'>0
- QUIT
- Begin DoDot:1
- +12 ;->
- SET TXT=$GET(^HL(772,IEN772,"IN",+LNO,0))
- if TXT']""
- QUIT
- +13 SET DATA("CHAR",772)=$GET(DATA("CHAR",772))+$LENGTH(TXT)
- +14 SET DATA("CHAR")=$GET(DATA("CHAR"))+$LENGTH(TXT)
- End DoDot:1
- +15 ;
- +16 QUIT
- +17 ;
- TOT772T(IEN772) ; Processing time...
- +1 ; No totals here. Just set times in DATA() array for later use...
- +2 NEW TIME
- +3 ;
- +4 ; Time of entry...
- +5 SET TIME=+$GET(^HL(772,+IEN772,0))
- +6 IF TIME?7N.E
- SET DATA("TIME",TIME,772,.01)=""
- +7 ;
- +8 ; Time processed...
- +9 SET TIME=$PIECE($GET(^HL(772,+IEN772,"P")),U,2)
- +10 IF TIME?7N.E
- SET DATA("TIME",TIME,772,21)=""
- +11 ;
- +12 QUIT
- +13 ;
- TOT773C(IEN773) ; Total number of characters...
- +1 ; DATA() -- passed in (See COLLECT)
- +2 NEW CHAR
- +3 ;->
- SET CHAR=$$MSGSIZE(+IEN773)
- if CHAR'>0
- QUIT
- +4 SET DATA("CHAR",773,IEN773)=CHAR
- +5 SET DATA("CHAR")=$GET(DATA("CHAR"))+CHAR
- +6 SET TOT773(IEN773)=CHAR
- +7 QUIT
- +8 ;
- MSGSIZE(IEN773) ; Number characters in 773 entry...
- +1 NEW NCH,NO
- +2 SET NCH=0
- SET NO=0
- +3 FOR
- SET NO=$ORDER(^HLMA(+IEN773,"MSH",NO))
- if NO'>0
- QUIT
- Begin DoDot:1
- +4 SET NCH=NCH+$LENGTH($GET(^HLMA(+IEN773,"MSH",+NO,0)))
- End DoDot:1
- +5 QUIT NCH
- +6 ;
- TOT773T(IEN773) ; Set TIMEs...
- +1 ; DATA() -- passed in (See COLLECT)
- +2 NEW TIME
- +3 ;
- +4 ; Creation time already taken from 772...
- +5 ;
- +6 ; Processed time...
- +7 ;->
- SET TIME=+$GET(^HLMA(+IEN773,"S"))
- if TIME'>0
- QUIT
- +8 SET DATA("TIME",TIME,773,100)=""
- +9 ;
- +10 QUIT
- +11 ;
- ERR(REA) ; Record error...
- +1 SET NOERR=NOERR+1
- +2 SET REA=$SELECT($GET(REA)]"":REA,1:"?")
- +3 SET ERRINFO(REA)=""
- +4 QUIT
- +5 ;
- SEC(FMDT) ;
- +1 SET FMDT=$$FMTH^XLFDT(FMDT)
- +2 QUIT $$SEC^XLFDT(FMDT)
- +3 ;
- TMDIFF ; DATA("TIME",...) -- req --> DATA("DIFF")
- +1 ; Default... HL*1.6*114
- SET (DATA("DIFF"),DATA("END"),DATA("START"))=""
- +2 ;->
- SET DATA("START")=$ORDER(DATA("TIME",0))
- if DATA("START")'>0
- QUIT
- +3 SET DATA("END")=$ORDER(DATA("TIME",":"),-1)
- +4 SET DATA("DIFF")=$$SEC(DATA("END"))-$$SEC(DATA("START"))
- +5 QUIT
- +6 ;
- XTMP ; Store in ^XTMP...
- +1 ; API Parameters -- req
- +2 NEW XTMP
- +3 ;
- +4 ;-> Must be ALL,ALL
- if PNMSP'=1!(IEN101'=1)
- QUIT
- +5 ;
- +6 SET XTMP="HLUCM "_$$DT^XLFDT
- +7 if '$DATA(^XTMP(XTMP,0))
- SET ^XTMP(XTMP,0)=$$FMADD^XLFDT($$DT^XLFDT,7)_U_$$NOW^XLFDT_U_"HLUCM Data"
- +8 ;
- +9 SET SVNO=$GET(^XTMP(XTMP,"P",+START,+END,COND))
- +10 IF SVNO'>0
- SET SVNO=$ORDER(^XTMP(XTMP,"N",":"),-1)+1
- +11 SET ^XTMP(XTMP,"P",+START,+END,COND)=SVNO_U_$$NOW^XLFDT
- +12 SET ^XTMP(XTMP,"N",+SVNO)=START_U_END_U_COND_U_HLAPI
- +13 KILL ^XTMP(XTMP,"D",+SVNO)
- +14 ;
- +15 MERGE ^XTMP(XTMP,"D",+SVNO)=^TMP(TOTALS,$JOB)
- +16 ;
- +17 QUIT
- +18 ;
- EOR ; HLUCM - HL7/Capacity Mgt API ;2/27/01 10:15