Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLUCM009

HLUCM009.m

Go to the documentation of this file.
  1. HLUCM009 ;CIOFO-O/LJA - HL7/Capacity Mgt API-II ;2/25/03-08:50
  1. ;;1.6;HEALTH LEVEL SEVEN;**103**;Oct 13, 1995
  1. ;
  1. IEN870(IEN772) ; Given 772 find 870...
  1. N DATA,I773,I870,IEN
  1. S DATA=$G(^HL(772,+IEN772,0))
  1. ;
  1. ; Logical Link field...
  1. S IEN=$P(DATA,U,11) I IEN QUIT IEN ;->
  1. ;
  1. ; Related Event Protocol...
  1. S IEN=$P(DATA,U,10),IEN=$P($G(^ORD(101,+IEN,770)),U,7) I IEN QUIT IEN ;->
  1. ;
  1. S I773=0
  1. F S I773=$O(^HLMA("B",IEN772,I773)) Q:I773'>0 D QUIT:I870
  1. . S I870=$P($G(^HLMA(+I773,0)),U,7)
  1. I $G(I870) QUIT +I870 ;->
  1. ;
  1. QUIT ""
  1. ;
  1. MSGTYPE(IEN772) ; MSG or MSA's type...
  1. N DEL,IN
  1. S IN=$G(^HL(772,+IEN772,"IN",1,0)) QUIT:IN']"" "MSG" ;->
  1. S DEL=$E(IN,4) QUIT:DEL']"" "MSG" ;->
  1. S IN=$P(IN,DEL,2) QUIT:IN']"" "MSG" ;->
  1. I $L(IN)=2,$E(IN)="C"!($E(IN)="A") QUIT IN ;->
  1. QUIT "MSG"
  1. ;
  1. KILLS(WHEN) ; Kills of ^TMP data WHEN (START or END or ALL)
  1. N DATA
  1. ;
  1. ; If ALL, set WHEN to include START and END...
  1. S:WHEN="ALL" WHEN="STARTandEND"
  1. ;
  1. ; Always KILLs...
  1. F DATA="ACTUAL","HLCHILD",$G(TOTALS)_"ERRTIME","HLOAD772","N","HLNMSP94","HLNMSPXRF","HLPARENT","HLRECNM","U","X" D
  1. . KILL ^TMP(DATA,$J),^TMP($J,DATA)
  1. ;
  1. ; START-only KILLs...
  1. I WHEN["START" D
  1. . F DATA="HLUCMSTORE","RFAC",$G(TOTALS) D
  1. . . QUIT:DATA']"" ;-> Sometimes TOTALS might not be defined
  1. . . KILL ^TMP(DATA,$J),^TMP($J,DATA)
  1. ;
  1. ; END-only KILLs...
  1. I WHEN["END" D
  1. . KILL HLAPI
  1. . ; Don't store any debug global data...
  1. . I $G(^TMP($J,"HLUCM"))'="DEBUG GLOBAL" KILL ^TMP($J)
  1. . F DATA="HL4","HLUCM","HLUCMDT" D
  1. . . KILL ^TMP($J,DATA),^TMP(DATA,$J)
  1. ;
  1. QUIT
  1. ;
  1. SITESMSH(TXT) ; Return location pieces, slightly modified...
  1. N DIV,P4,P6
  1. S DIV=$E(TXT,4),P4=$P(TXT,DIV,4),P6=$P(TXT,DIV,6)
  1. S P4=$S(P4?1.N1"~"!(P4?1.N):+P4,1:"")
  1. S P6=$S(P6?1.N1"~"!(P6?1.N):+P6,1:"")
  1. QUIT P4_U_P6
  1. ;
  1. MAILTYPE(MIEN) ; Is MSH in Mailman message local or remote...
  1. N IEN,RECNO,TO,TOID,TYPE
  1. S TYPE="L"
  1. KILL ^TMP($J,"HLMAILTYPE")
  1. D QD^XMXUTIL3(+MIEN,,,,,"^TMP($J,""HLMAILTYPE"")")
  1. S RECNO=0
  1. F S RECNO=$O(^TMP($J,"HLMAILTYPE","XMLIST",RECNO)) Q:RECNO'>0!(TYPE'="L") D
  1. . S TO=$G(^TMP($J,"HLMAILTYPE","XMLIST",+RECNO,"TO"))
  1. . S TOID=$G(^TMP($J,"HLMAILTYPE","XMLIST",+RECNO,"TO ID"))
  1. . I TO["@"!(TOID="R") S TYPE="R"
  1. KILL ^TMP($J,"HLMAILTYPE")
  1. QUIT TYPE
  1. ;
  1. NMSPXRF ; Xref of namespaces that can be inferred. (If start with DG change to DG)
  1. N I,T KILL ^TMP($J,"HLNMSPXRF") F I=2:1 S T=$T(NMSPXRF+I) Q:T'[";;" S T=$P(T,";;",2,99),^TMP($J,"HLNMSPXRF",$P(T,U))=$P(T,U,2)
  1. ;;DG^DG
  1. ;;GM^GM
  1. ;;HEC^HEC
  1. ;;IB^IB
  1. ;;IVM^IVM
  1. ;;LA^LA
  1. ;;MPI^MPI
  1. ;;OR^OR
  1. ;;PR^PR
  1. ;;PS^PS
  1. ;;RG^RG
  1. ;;ROR^ROR
  1. ;;SC^SC
  1. ;;VEI^VEIB
  1. ;;XM^XMB
  1. ;;XU^XU
  1. ;;XW^XWB
  1. Q
  1. ;
  1. ACCUMLAT(CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4) ; Generic accumulator
  1. ;
  1. I $G(SUB4)]"" D
  1. . S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4))
  1. . D INCR^HLUCM001
  1. . S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4)=TOTCURR
  1. ;
  1. S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3))
  1. D INCR^HLUCM001
  1. S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3)=TOTCURR
  1. ;
  1. ; Totals level 2 for SUB...
  1. S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2))
  1. D INCR^HLUCM001
  1. S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2)=TOTCURR
  1. ;
  1. ; Totals level 1 for SUB...
  1. S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1))
  1. D INCR^HLUCM001
  1. S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1)=TOTCURR
  1. ;
  1. ; Total level TYPE/SORT...
  1. S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT))
  1. D INCR^HLUCM001
  1. S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT)=TOTCURR
  1. ;
  1. ; Total level TYPE
  1. S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE))
  1. D INCR^HLUCM001
  1. S ^TMP(TOTALS,$J,CATEGORY,TYPE)=TOTCURR
  1. ;
  1. ; Total level CATEGORY
  1. ; [Don't subtotal here, for NMSP holds two different TYPEs, and
  1. ; if totalled here, it would double count.]
  1. ;
  1. QUIT
  1. ;
  1. LOAD772S(IEN772,HLNMSP) ; Load list of related 772s... [HL*1.6*91]
  1. ;
  1. ; Warning!!! This call point will never load more than 20 entries...
  1. ; Any more than that, and probably an error condition
  1. ; exists.
  1. ;
  1. N ACKTO,CHILD,DATA,FAC,HL772,HLI,HLJ,HLK,HLN,HLPCKG,HLZZI,HOLDNMSP,I
  1. N I772,I773,MSGID,NUM,PARENT,PCKG,PIEN,PROT,TOTNUM,VAL,X
  1. ;
  1. KILL HLNMSP
  1. QUIT:$G(^HL(772,+$G(IEN772),0))']"" "" ;->
  1. ;
  1. S DATA=$G(^HL(772,+$G(IEN772),0)) QUIT:DATA']"" "" ;->
  1. ;
  1. ; Loop until no new entries found or more than 20 entries...
  1. S NUM=$$LOADEM^HLUCM050(+IEN772,.HLNMSP)
  1. ;
  1. QUIT NUM
  1. ;
  1. HOLDTOT(IEN) ; Accumulate...
  1. QUIT:$D(HOLDNMSP(IEN))!(TOTNUM>19) ;->
  1. S HOLDNMSP(IEN)="",TOTNUM=TOTNUM+1
  1. QUIT
  1. ;
  1. SETUP() ; Perform checks, which can return error conditions, and
  1. ; set up variables for $$LOOP. This extrinsic function returns
  1. ; "" if no errors, or the # errors found. (Note that error
  1. ; details placed in ERRINFO(ERROR-REASON)="")
  1. N NOERR
  1. S NOERR=""
  1. D SETDEF ; Set defaults for parameters, if not passed
  1. D FINDWAY ; Find way NMSP and PROT parameters passed
  1. D SETMORE^HLUCM003 ; Additional var sets based on parameters & "way"...
  1. D ERRCHK^HLUCM003 ; Check for errors...
  1. KILL ^TMP(TOTALS,$J) ; Clear out storage location...
  1. QUIT NOERR
  1. ;
  1. SETDEF ; Set various defaults...
  1. I '$D(PNMSP) S PNMSP=1
  1. I '$D(IEN101) S IEN101=1
  1. I $G(TOTALS)']"" S TOTALS="HLTOTALS"
  1. S COND=$$UP^XLFSTR(COND)
  1. S COND=$S($G(COND)="BOTH":COND,1:"EITHER") ; Default to EITHER matches, count it...
  1. QUIT
  1. ;
  1. FINDWAY ; How were NMSP and PROT passed? By reference? (If so, return 1)
  1. ; Passed by reference?
  1. S NMSPTYPE=$S($G(PNMSP)']""&($O(PNMSP(""))]""):1,1:0) ; 1=YES
  1. S PROTYPE=$S($G(IEN101)']""&($O(IEN101(""))]""):1,1:0) ; 1=YES
  1. QUIT
  1. ;
  1. MSGID(MSGID) ; Search forward for MSA's to this MSGID...
  1. N BIEN,CT,D,HOLD,I772,I773,MSA,X
  1. ;
  1. S X=$O(^HL(772,"C",MSGID,0)) I X S HOLD(X)=""
  1. S X=$O(^HLMA("C",MSGID,0)) I X S X=+$G(^HLMA(+X,0)) I X S HOLD(X)=""
  1. ;
  1. Q
  1. ;
  1. ERRMOVE(IEN772) ; Move all associated data out of ^TMP's totaling arrays
  1. N IEN772C,IEN772P
  1. ;
  1. ; Find parent message (because have to move ALL associated messages out)
  1. QUIT:$G(^TMP($J,"HLUCM"))'="DEBUG GLOBAL" ;->
  1. S IEN772P=$O(^TMP($J,"HLUCMSTORE","X",+IEN772,0))
  1. I IEN772P'>0 S IEN772P=IEN772
  1. ;
  1. ; Loop thru all associated messages in unit...
  1. S IEN772C=0
  1. F S IEN772C=$O(^TMP($J,"HLUCMSTORE","U",IEN772P,IEN772C)) Q:'IEN772C D
  1. . F SUB="C","E","O","X" D
  1. . . MERGE ^TMP($J,"HLUCMSTORE","ERR",SUB,IEN772C)=^TMP($J,"HLUCMSTORE",SUB,IEN772C)
  1. . . KILL ^TMP($J,"HLUCMSTORE",SUB,IEN772C)
  1. ;
  1. ; Maybe there is no X xref...
  1. MERGE ^TMP($J,"HLUCMSTORE","ERR","E",+IEN772P)=^TMP($J,"HLUCMSTORE","E",+IEN772P)
  1. KILL ^TMP($J,"HLUCMSTORE","E",+IEN772P)
  1. ;
  1. ; Finally, move the unit's data...
  1. MERGE ^TMP($J,"HLUCMSTORE","ERR","U",IEN772P)=^TMP($J,"HLUCMSTORE","U",IEN772P)
  1. KILL ^TMP($J,"HLUCMSTORE","U",IEN772P)
  1. ;
  1. Q
  1. ;
  1. EOR ;HLUCM009 - HL7/Capacity Mgt API-II ;2/25/03-08:50