PXVWMSG ;ISP/LMT - Build ICE Message ;12/13/17 12:23
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
;
;
BLD(DFN,PXELEMENT) ; Entry Point.
;
; Builds ICE Message (based off template in #920.77)
;
;Input:
; DFN - Patient (#2) IEN
; PXELEMENT - Root element name (from #920.77)
;
;Returns:
; Message in ^TMP("PXVWMSG",$J,n)
;
N PXCNT,PXELIEN,PXUUID
;
K ^TMP("PXVWMSG",$J)
K ^TMP("PXVWMSG-OPT",$J)
S PXCNT=0
S PXUUID=0
;
S PXELIEN=$O(^PXV(920.77,"B",$G(PXELEMENT),0))
I 'PXELIEN Q
;
D ADDEL(DFN,PXELIEN)
;
K ^TMP("PXVWMSG-OPT",$J)
;
Q
;
ADDEL(DFN,PXELIEN,PXPARENT) ; Add element to message. Recursively adds children.
;
N PXABSTRACT,PXCHILD,PXMODIFIER,PXMULTIPLE,PXOPTIONAL,PXSKIP,PXSORT,PXVARS,PXX
;
S PXPARENT=$G(PXPARENT)
S PXMODIFIER=$P($G(^PXV(920.77,PXELIEN,0)),U,4)
S PXOPTIONAL=(PXMODIFIER="O")
S PXMULTIPLE=(PXMODIFIER="M")
S PXABSTRACT=(PXMODIFIER="A")
;
; DFN must be defined for BUILD LOGIC.
; BUILD LOGIC can set PXSKIP to true, if this element should be skipped.
; BUILD LOGIC can define PXVARS array, with the variables needed to update the template.
I $G(^PXV(920.77,PXELIEN,1))'="" X ^PXV(920.77,PXELIEN,1)
I PXMULTIPLE,'$O(PXVARS(0)) S PXSKIP=1
I $G(PXSKIP) Q
;
; if this element is optional, push it on the "optional" stack (i.e., ^TMP("PXVWMSG-OPT"))
; and if any of its children are added to the message, we will come back to
; add the optional element on the stack before adding the child.
I PXOPTIONAL D
. S PXX=$O(^TMP("PXVWMSG-OPT",$J,"A"),-1)+1
. S ^TMP("PXVWMSG-OPT",$J,PXX)=PXELIEN
. S ^TMP("PXVWMSG-OPT",$J,"B",PXELIEN,PXX)=""
. M ^TMP("PXVWMSG-OPT",$J,PXX,"PXVARS")=PXVARS
;
; if this element is being added to the mesage,
; check the "optional" stack, and if there are any
; optional parent elements, first add those elements
; before adding this element.
; Only add the pre-content and content; the post-content
; will be added later.
; When done, clear the "optional" stack.
I 'PXOPTIONAL,'PXABSTRACT,$D(^TMP("PXVWMSG-OPT",$J)) D
. N PXOELIEN,PXOVARS
. S PXX=0
. F S PXX=$O(^TMP("PXVWMSG-OPT",$J,PXX)) Q:'PXX D
. . S PXOELIEN=$G(^TMP("PXVWMSG-OPT",$J,PXX))
. . M PXOVARS=^TMP("PXVWMSG-OPT",$J,PXX,"PXVARS")
. . D ADDCNTNT(PXOELIEN,2,.PXOVARS)
. . D ADDCNTNT(PXOELIEN,3,.PXOVARS)
. ; clear the "optional" stack
. K ^TMP("PXVWMSG-OPT",$J)
;
I PXMULTIPLE D Q
. N PXMVARS
. S PXX=0
. F S PXX=$O(PXVARS(PXX)) Q:'PXX D
. . M PXMVARS=PXVARS(PXX)
. . D ADDCNTNT(PXELIEN,2,.PXMVARS)
. . D ADDCNTNT(PXELIEN,3,.PXMVARS)
. . D ADDCNTNT(PXELIEN,4,.PXMVARS)
;
; add pre-content
I 'PXOPTIONAL,'PXABSTRACT D
. D ADDCNTNT(PXELIEN,2,.PXVARS,PXPARENT)
;
; add content
I 'PXOPTIONAL,'PXABSTRACT D
. D ADDCNTNT(PXELIEN,3,.PXVARS,PXPARENT)
;
; recursively add children
S PXSORT=0
F S PXSORT=$O(^PXV(920.77,"ACHILD",PXELIEN,PXSORT)) Q:'PXSORT D
. S PXCHILD=0
. F S PXCHILD=$O(^PXV(920.77,"ACHILD",PXELIEN,PXSORT,PXCHILD)) Q:'PXCHILD D
. . I PXABSTRACT D ADDEL(DFN,PXCHILD,PXELIEN) Q
. . D ADDEL(DFN,PXCHILD)
;
; if this element is still on the "optional" stack,
; then remove it, and don't display the post-content
; as none of its children were added to the message.
S PXX=0
I PXOPTIONAL D Q:PXX
. S PXX=$O(^TMP("PXVWMSG-OPT",$J,"B",PXELIEN,PXX))
. I 'PXX Q
. K ^TMP("PXVWMSG-OPT",$J,PXX)
. K ^TMP("PXVWMSG-OPT",$J,"B",PXELIEN)
;
; add post-content
I 'PXABSTRACT D
. D ADDCNTNT(PXELIEN,4,.PXVARS,PXPARENT)
Q
;
ADDCNTNT(PXELIEN,PXNODE,PXVARS,PXPARENT) ; Add content
;
N PXIEN,PXLINE,PXNEWTEXT,PXTEXT,PXX
;
S PXIEN=PXELIEN
; if inheriting from parent and it hasn't been overriden, use parent content
I $G(PXPARENT),'$D(^PXV(920.77,PXELIEN,PXNODE)) S PXIEN=PXPARENT
;
I $D(^PXV(920.77,PXIEN,PXNODE)) D
. S PXX=0
. F S PXX=$O(^PXV(920.77,PXIEN,PXNODE,PXX)) Q:'PXX D
. . S PXLINE=$G(^PXV(920.77,PXIEN,PXNODE,PXX,0))
. . I ($D(PXVARS)&(PXLINE["|"))!(PXLINE["|UUID|") D
. . . S PXLINE=$$REPLACE(PXLINE,.PXVARS)
. . D ADDLINE(.PXLINE)
;
Q
;
REPLACE(PXTEXT,PXVARS) ; replace expressions between vertical bars
;
; ZEXCEPT: PXUUID
;
N PXI,PXRESULT,PXVAR
;
S PXRESULT=$P(PXTEXT,"|",1)
F PXI=2:2 S PXVAR=$P(PXTEXT,"|",PXI) Q:PXVAR="" D
. I PXVAR="UUID" D Q
. . S PXUUID=PXUUID+1
. . S PXRESULT=PXRESULT_PXUUID_$P(PXTEXT,"|",PXI+1)
. S PXRESULT=PXRESULT_$G(PXVARS(PXVAR))_$P(PXTEXT,"|",PXI+1)
;
Q PXRESULT
;
ADDLINE(PXLINE) ;add line to message global
;
; ZEXCEPT: PXCNT
;
S PXCNT=PXCNT+1
S ^TMP("PXVWMSG",$J,PXCNT)=PXLINE
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVWMSG 4666 printed Dec 13, 2024@02:32:16 Page 2
PXVWMSG ;ISP/LMT - Build ICE Message ;12/13/17 12:23
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 ;
+3 ;
BLD(DFN,PXELEMENT) ; Entry Point.
+1 ;
+2 ; Builds ICE Message (based off template in #920.77)
+3 ;
+4 ;Input:
+5 ; DFN - Patient (#2) IEN
+6 ; PXELEMENT - Root element name (from #920.77)
+7 ;
+8 ;Returns:
+9 ; Message in ^TMP("PXVWMSG",$J,n)
+10 ;
+11 NEW PXCNT,PXELIEN,PXUUID
+12 ;
+13 KILL ^TMP("PXVWMSG",$JOB)
+14 KILL ^TMP("PXVWMSG-OPT",$JOB)
+15 SET PXCNT=0
+16 SET PXUUID=0
+17 ;
+18 SET PXELIEN=$ORDER(^PXV(920.77,"B",$GET(PXELEMENT),0))
+19 IF 'PXELIEN
QUIT
+20 ;
+21 DO ADDEL(DFN,PXELIEN)
+22 ;
+23 KILL ^TMP("PXVWMSG-OPT",$JOB)
+24 ;
+25 QUIT
+26 ;
ADDEL(DFN,PXELIEN,PXPARENT) ; Add element to message. Recursively adds children.
+1 ;
+2 NEW PXABSTRACT,PXCHILD,PXMODIFIER,PXMULTIPLE,PXOPTIONAL,PXSKIP,PXSORT,PXVARS,PXX
+3 ;
+4 SET PXPARENT=$GET(PXPARENT)
+5 SET PXMODIFIER=$PIECE($GET(^PXV(920.77,PXELIEN,0)),U,4)
+6 SET PXOPTIONAL=(PXMODIFIER="O")
+7 SET PXMULTIPLE=(PXMODIFIER="M")
+8 SET PXABSTRACT=(PXMODIFIER="A")
+9 ;
+10 ; DFN must be defined for BUILD LOGIC.
+11 ; BUILD LOGIC can set PXSKIP to true, if this element should be skipped.
+12 ; BUILD LOGIC can define PXVARS array, with the variables needed to update the template.
+13 IF $GET(^PXV(920.77,PXELIEN,1))'=""
XECUTE ^PXV(920.77,PXELIEN,1)
+14 IF PXMULTIPLE
IF '$ORDER(PXVARS(0))
SET PXSKIP=1
+15 IF $GET(PXSKIP)
QUIT
+16 ;
+17 ; if this element is optional, push it on the "optional" stack (i.e., ^TMP("PXVWMSG-OPT"))
+18 ; and if any of its children are added to the message, we will come back to
+19 ; add the optional element on the stack before adding the child.
+20 IF PXOPTIONAL
Begin DoDot:1
+21 SET PXX=$ORDER(^TMP("PXVWMSG-OPT",$JOB,"A"),-1)+1
+22 SET ^TMP("PXVWMSG-OPT",$JOB,PXX)=PXELIEN
+23 SET ^TMP("PXVWMSG-OPT",$JOB,"B",PXELIEN,PXX)=""
+24 MERGE ^TMP("PXVWMSG-OPT",$JOB,PXX,"PXVARS")=PXVARS
End DoDot:1
+25 ;
+26 ; if this element is being added to the mesage,
+27 ; check the "optional" stack, and if there are any
+28 ; optional parent elements, first add those elements
+29 ; before adding this element.
+30 ; Only add the pre-content and content; the post-content
+31 ; will be added later.
+32 ; When done, clear the "optional" stack.
+33 IF 'PXOPTIONAL
IF 'PXABSTRACT
IF $DATA(^TMP("PXVWMSG-OPT",$JOB))
Begin DoDot:1
+34 NEW PXOELIEN,PXOVARS
+35 SET PXX=0
+36 FOR
SET PXX=$ORDER(^TMP("PXVWMSG-OPT",$JOB,PXX))
if 'PXX
QUIT
Begin DoDot:2
+37 SET PXOELIEN=$GET(^TMP("PXVWMSG-OPT",$JOB,PXX))
+38 MERGE PXOVARS=^TMP("PXVWMSG-OPT",$JOB,PXX,"PXVARS")
+39 DO ADDCNTNT(PXOELIEN,2,.PXOVARS)
+40 DO ADDCNTNT(PXOELIEN,3,.PXOVARS)
End DoDot:2
+41 ; clear the "optional" stack
+42 KILL ^TMP("PXVWMSG-OPT",$JOB)
End DoDot:1
+43 ;
+44 IF PXMULTIPLE
Begin DoDot:1
+45 NEW PXMVARS
+46 SET PXX=0
+47 FOR
SET PXX=$ORDER(PXVARS(PXX))
if 'PXX
QUIT
Begin DoDot:2
+48 MERGE PXMVARS=PXVARS(PXX)
+49 DO ADDCNTNT(PXELIEN,2,.PXMVARS)
+50 DO ADDCNTNT(PXELIEN,3,.PXMVARS)
+51 DO ADDCNTNT(PXELIEN,4,.PXMVARS)
End DoDot:2
End DoDot:1
QUIT
+52 ;
+53 ; add pre-content
+54 IF 'PXOPTIONAL
IF 'PXABSTRACT
Begin DoDot:1
+55 DO ADDCNTNT(PXELIEN,2,.PXVARS,PXPARENT)
End DoDot:1
+56 ;
+57 ; add content
+58 IF 'PXOPTIONAL
IF 'PXABSTRACT
Begin DoDot:1
+59 DO ADDCNTNT(PXELIEN,3,.PXVARS,PXPARENT)
End DoDot:1
+60 ;
+61 ; recursively add children
+62 SET PXSORT=0
+63 FOR
SET PXSORT=$ORDER(^PXV(920.77,"ACHILD",PXELIEN,PXSORT))
if 'PXSORT
QUIT
Begin DoDot:1
+64 SET PXCHILD=0
+65 FOR
SET PXCHILD=$ORDER(^PXV(920.77,"ACHILD",PXELIEN,PXSORT,PXCHILD))
if 'PXCHILD
QUIT
Begin DoDot:2
+66 IF PXABSTRACT
DO ADDEL(DFN,PXCHILD,PXELIEN)
QUIT
+67 DO ADDEL(DFN,PXCHILD)
End DoDot:2
End DoDot:1
+68 ;
+69 ; if this element is still on the "optional" stack,
+70 ; then remove it, and don't display the post-content
+71 ; as none of its children were added to the message.
+72 SET PXX=0
+73 IF PXOPTIONAL
Begin DoDot:1
+74 SET PXX=$ORDER(^TMP("PXVWMSG-OPT",$JOB,"B",PXELIEN,PXX))
+75 IF 'PXX
QUIT
+76 KILL ^TMP("PXVWMSG-OPT",$JOB,PXX)
+77 KILL ^TMP("PXVWMSG-OPT",$JOB,"B",PXELIEN)
End DoDot:1
if PXX
QUIT
+78 ;
+79 ; add post-content
+80 IF 'PXABSTRACT
Begin DoDot:1
+81 DO ADDCNTNT(PXELIEN,4,.PXVARS,PXPARENT)
End DoDot:1
+82 QUIT
+83 ;
ADDCNTNT(PXELIEN,PXNODE,PXVARS,PXPARENT) ; Add content
+1 ;
+2 NEW PXIEN,PXLINE,PXNEWTEXT,PXTEXT,PXX
+3 ;
+4 SET PXIEN=PXELIEN
+5 ; if inheriting from parent and it hasn't been overriden, use parent content
+6 IF $GET(PXPARENT)
IF '$DATA(^PXV(920.77,PXELIEN,PXNODE))
SET PXIEN=PXPARENT
+7 ;
+8 IF $DATA(^PXV(920.77,PXIEN,PXNODE))
Begin DoDot:1
+9 SET PXX=0
+10 FOR
SET PXX=$ORDER(^PXV(920.77,PXIEN,PXNODE,PXX))
if 'PXX
QUIT
Begin DoDot:2
+11 SET PXLINE=$GET(^PXV(920.77,PXIEN,PXNODE,PXX,0))
+12 IF ($DATA(PXVARS)&(PXLINE["|"))!(PXLINE["|UUID|")
Begin DoDot:3
+13 SET PXLINE=$$REPLACE(PXLINE,.PXVARS)
End DoDot:3
+14 DO ADDLINE(.PXLINE)
End DoDot:2
End DoDot:1
+15 ;
+16 QUIT
+17 ;
REPLACE(PXTEXT,PXVARS) ; replace expressions between vertical bars
+1 ;
+2 ; ZEXCEPT: PXUUID
+3 ;
+4 NEW PXI,PXRESULT,PXVAR
+5 ;
+6 SET PXRESULT=$PIECE(PXTEXT,"|",1)
+7 FOR PXI=2:2
SET PXVAR=$PIECE(PXTEXT,"|",PXI)
if PXVAR=""
QUIT
Begin DoDot:1
+8 IF PXVAR="UUID"
Begin DoDot:2
+9 SET PXUUID=PXUUID+1
+10 SET PXRESULT=PXRESULT_PXUUID_$PIECE(PXTEXT,"|",PXI+1)
End DoDot:2
QUIT
+11 SET PXRESULT=PXRESULT_$GET(PXVARS(PXVAR))_$PIECE(PXTEXT,"|",PXI+1)
End DoDot:1
+12 ;
+13 QUIT PXRESULT
+14 ;
ADDLINE(PXLINE) ;add line to message global
+1 ;
+2 ; ZEXCEPT: PXCNT
+3 ;
+4 SET PXCNT=PXCNT+1
+5 SET ^TMP("PXVWMSG",$JOB,PXCNT)=PXLINE
+6 ;
+7 QUIT
