- NHINVLRO ;SLC/MKB -- Laboratory extract by order/panel
- ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^DPT 10035
- ; ^LAB(60 67,91,10054
- ; ^LRO(69 2407
- ; ^LR 525
- ; DIQ 2056
- ; LR7OR1,^TMP("LRRR",$J) 2503
- ; XUAF4 2171
- ;
- ; ------------ Get results from VistA ------------
- ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
- N NHSUB,NHIDT,NHI,NHT,NHITM,CMMT,LRDFN,LR0,X
- S DFN=+$G(DFN) Q:$G(DFN)<1
- S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
- S LRDFN=$G(^DPT(DFN,"LR")),NHSUB="CH"
- K ^TMP("LRRR",$J,DFN)
- ;
- ; get result(s)
- I $G(ID) D RR^LR7OR1(DFN,ID)
- I '$G(ID) D ;no id, or accession format (no lab order)
- . S:$G(ID)'="" NHSUB=$P(ID,";"),(BEG,END)=9999999-$P(ID,";",2)
- . D RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
- ;
- S NHSUB="" F S NHSUB=$O(^TMP("LRRR",$J,DFN,NHSUB)) Q:NHSUB="" D
- . S NHIDT=0 F S NHIDT=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT)) Q:NHIDT<1 I $O(^(NHIDT,0)) D
- .. I "CH^MI"'[NHSUB Q
- .. D SORT ;group accession by lab orders > NHLRO(panel,NHI)=data node
- .. S NHT="" F S NHT=$O(NHLRO(NHT)) Q:NHT="" D
- ... K NHITM,CMMT S X=$G(NHLRO(NHT))
- ... I $G(ID),ID'=$P(X,U,3) Q ;single order only
- ... S NHITM("id")=$P(X,U,3),NHITM("order")=$P(X,U,1,2)
- ... S NHITM("type")=NHSUB,NHITM("status")="completed"
- ... S NHITM("collected")=9999999-NHIDT
- ... S LR0=$G(^LR(LRDFN,NHSUB,NHIDT,0))
- ... S NHITM("resulted")=$P(LR0,U,3),X=+$P(LR0,U,5) I X D ;specimen
- .... N IENS,NHY S IENS=X_","
- .... D GETS^DIQ(61,IENS,".01:2",,"NHY")
- .... S NHITM("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
- .... S NHITM("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
- ... S NHITM("groupName")=$P(LR0,U,6),X=+$P(LR0,U,14)
- ... S:X NHITM("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
- ... I 'X S NHITM("facility")=$$FAC^NHINV ;local stn#^name
- ... S NHI=0 F S NHI=$O(NHLRO(NHT,NHI)) Q:NHI<1 D
- .... S X=$G(NHLRO(NHT,NHI))
- .... S:NHSUB="CH" NHITM("value",NHI)=$$CH(X)
- .... S:NHSUB="MI" NHITM("value",NHI)=$$MI(X)
- ... I $D(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,"N")) M CMMT=^("N") S NHITM("comment")=$$STRING^NHINV(.CMMT)
- ... D XML(.NHITM)
- K ^TMP("LRRR",$J,DFN)
- Q
- ;
- SORT ; -- return NHLRO(PANEL) = CPRS order# ^ panel/test name ^ Lab Order string
- ; NHLRO(PANEL,NHI) = result node
- N X0,NUM,ORD,ODT,SN,T,T0,I,NHY,NHLRT K NHLRO
- S NHI=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,0)),X0=$G(^(NHI)) ;first
- S NUM=$P(X0,U,16),ORD=$P(X0,U,17),ODT=+$P(9999999-NHIDT,".")
- ; - build NHLRT list of result nodes for each test/panel
- I ORD S SN=0 F S SN=$O(^LRO(69,"C",ORD,ODT,SN)) Q:SN<1 D Q:$D(NHLRT)
- . I $G(ID),$P(ID,";",3)'=SN Q
- . S T=0 F S T=+$O(^LRO(69,ODT,1,SN,2,T)) Q:T<1 D
- .. I $G(ID),T'=$P(ID,";",4) Q
- .. S T0=$G(^LRO(69,ODT,1,SN,2,T,0))
- .. ; is test/panel part of same accession?
- .. Q:$P(T0,U,5)'=+$P(NUM," ",3)
- .. Q:$$GET1^DIQ(68,$P(T0,U,4)_",",.09)'=$P(NUM," ")
- .. ; expand panel into unit tests
- .. K NHY D EXPAND(+T0,.NHY)
- .. S I=0 F S I=$O(NHY(I)) Q:I<1 S NHLRT(I,+T0)="" ;NHLRT(test,panel)=""
- .. S NHLRO(+T0)=$P(T0,U,7)_U_$P($G(^LAB(60,+T0,0)),U)_U_ORD_";"_ODT_";"_SN_";"_T
- S:'$D(NHLRO) NHLRO(0)=$S(NHSUB="MI":"^MICROBIOLOGY^MI;",1:"^ACCESSION^CH;")_NHIDT ;no Lab Order
- ; - build NHLRO(panel#,NHI) = ^TMP node
- S NHI=0 F S NHI=$O(^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI)) Q:NHI<1 S X0=$G(^(NHI)) D
- . I '$D(NHLRT(+X0)) S NHLRO(0,NHI)=X0 Q ;no Lab Order
- . S T=0 F S T=$O(NHLRT(+X0,T)) Q:T<1 S NHLRO(T,NHI)=X0
- Q
- ;
- EXPAND(TEST,ARAY) ;Expand a lab test panel [LR7OU1]
- ;TEST=Test ptr to file 60
- ;Expanded panel returned in ARAY(TEST)
- N INARAY
- D EX(TEST)
- M ARAY=INARAY
- Q
- EX(TST) ;
- N J,X,SUB
- Q:'$D(^LAB(60,TST,0)) S SUB=$P(^(0),"^",5)
- I $L(SUB) S:'$D(INARAY(+TST)) INARAY(+TST)="" Q
- S J=0 F S J=$O(^LAB(60,+TST,2,J)) Q:J<1 S X=^(J,0) D EX(+X)
- Q
- ;
- ACC(NUM,ODT,SN) ; -- Return 1 or 0, if Specimen entry matches accession
- N T,T0,Y S Y=0
- S T=+$O(^LRO(69,ODT,1,SN,2,0)),T0=$G(^(T,0))
- I $P(T0,U,5)=+$P(NUM," ",3),$$GET1^DIQ(68,$P(T0,U,4)_",",.09)=$P(NUM," ") S Y=1
- Q Y
- ;
- CH(X0) ; -- return a Chemistry result as:
- ; id^test^result^interpretation^units^low^high^loinc^vuid
- ; Expects X0=^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
- N X,Y,NODE,LOINC
- S NODE=$G(^LR(LRDFN,"CH",NHIDT,NHI))
- S X=$P($G(^LAB(60,+X0,0)),U)
- S Y="CH;"_NHIDT_";"_NHI_U_X_U_$P(X0,U,2,4)
- S X=$P(X0,U,5) I $L(X),X["-" S X=$TR(X,"- ","^"),$P(Y,U,6,7)=X
- S X=$P($P(NODE,U,3),"!",3) S:X LOINC=$$GET1^DIQ(95.3,X_",",.01)
- I '$G(LOINC) S X=+$P(X0,U,19) S:X LOINC=$$LOINC(+X0,X)
- S $P(Y,U,8,9)=$G(LOINC)_U_$$VUID^NHINV(+$G(LOINC),95.3)
- Q Y
- ;
- LOINC(TEST,SPEC) ; -- Look up LOINC code, if not mapped
- N Y,LAM,NHIN,IENS S Y=""
- S TEST=+$G(TEST),SPEC=+$G(SPEC)
- S LAM=$G(^LAB(60,TEST,64)),LAM=$S($P(LAM,U,2):$P(LAM,U,2),1:+LAM)
- D GETS^DIQ(64.01,SPEC_","_LAM_",","30*",,"NHIN")
- S IENS=$O(NHIN(64.02,"")) S:IENS Y=$G(NHIN(64.02,IENS,4))
- S:'Y Y=$$GET1^DIQ(60.01,SPEC_","_TEST_",",95.3)
- Q Y
- ;
- MI(X0) ; -- return a Microbiology result as:
- ; id^test^result^interpretation^units
- ; Expects X0=^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)
- N Y S Y=""
- S:$L($P(X0,U))>1 Y="MI;"_NHIDT_";"_NHI_U_$P(X0,U,1,4)
- Q Y
- ;
- ; ------------ Return data to middle tier ------------
- ;
- XML(LAB) ; -- Return result as XML in @NHIN@(#)
- N ATT,X,Y,I,J,P,NAMES,TAG
- D ADD("<panel>") S NHINTOTL=$G(NHINTOTL)+1
- S ATT="" F S ATT=$O(LAB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
- . I $O(LAB(ATT,0)) D S Y="" Q
- .. D ADD("<"_ATT_"s>")
- .. I ATT="value" S NAMES="id^test^result^interpretation^units^low^high^loinc^vuid^Z"
- .. E S NAMES="code^name^Z"
- .. S I=0 F S I=$O(LAB(ATT,I)) Q:I<1 D
- ... S X=$G(LAB(ATT,I)),Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
- .. D ADD("</"_ATT_"s>")
- . S X=$G(LAB(ATT)),Y="" Q:'$L(X)
- . I ATT="comment" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
- . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
- . I $L(X)>1 S NAMES="code^name^Z",Y="<"_ATT_" "_$$LOOP_"/>"
- D ADD("</panel>")
- Q
- ;
- LOOP() ; -- build sub-items string from NAMES and X
- N STR,P,TAG S STR=""
- F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
- Q STR
- ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- S NHINI=$G(NHINI)+1
- S @NHIN@(NHINI)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVLRO 6488 printed Feb 18, 2025@23:43:44 Page 2
- NHINVLRO ;SLC/MKB -- Laboratory extract by order/panel
- +1 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- +2 ;
- +3 ; External References DBIA#
- +4 ; ------------------- -----
- +5 ; ^DPT 10035
- +6 ; ^LAB(60 67,91,10054
- +7 ; ^LRO(69 2407
- +8 ; ^LR 525
- +9 ; DIQ 2056
- +10 ; LR7OR1,^TMP("LRRR",$J) 2503
- +11 ; XUAF4 2171
- +12 ;
- +13 ; ------------ Get results from VistA ------------
- +14 ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
- +1 NEW NHSUB,NHIDT,NHI,NHT,NHITM,CMMT,LRDFN,LR0,X
- +2 SET DFN=+$GET(DFN)
- if $GET(DFN)<1
- QUIT
- +3 SET BEG=$GET(BEG,1410101)
- SET END=$GET(END,9999998)
- SET MAX=$GET(MAX,999999)
- +4 SET LRDFN=$GET(^DPT(DFN,"LR"))
- SET NHSUB="CH"
- +5 KILL ^TMP("LRRR",$JOB,DFN)
- +6 ;
- +7 ; get result(s)
- +8 IF $GET(ID)
- DO RR^LR7OR1(DFN,ID)
- +9 ;no id, or accession format (no lab order)
- IF '$GET(ID)
- Begin DoDot:1
- +10 if $GET(ID)'=""
- SET NHSUB=$PIECE(ID,";")
- SET (BEG,END)=9999999-$PIECE(ID,";",2)
- +11 DO RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
- End DoDot:1
- +12 ;
- +13 SET NHSUB=""
- FOR
- SET NHSUB=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB))
- if NHSUB=""
- QUIT
- Begin DoDot:1
- +14 SET NHIDT=0
- FOR
- SET NHIDT=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT))
- if NHIDT<1
- QUIT
- IF $ORDER(^(NHIDT,0))
- Begin DoDot:2
- +15 IF "CH^MI"'[NHSUB
- QUIT
- +16 ;group accession by lab orders > NHLRO(panel,NHI)=data node
- DO SORT
- +17 SET NHT=""
- FOR
- SET NHT=$ORDER(NHLRO(NHT))
- if NHT=""
- QUIT
- Begin DoDot:3
- +18 KILL NHITM,CMMT
- SET X=$GET(NHLRO(NHT))
- +19 ;single order only
- IF $GET(ID)
- IF ID'=$PIECE(X,U,3)
- QUIT
- +20 SET NHITM("id")=$PIECE(X,U,3)
- SET NHITM("order")=$PIECE(X,U,1,2)
- +21 SET NHITM("type")=NHSUB
- SET NHITM("status")="completed"
- +22 SET NHITM("collected")=9999999-NHIDT
- +23 SET LR0=$GET(^LR(LRDFN,NHSUB,NHIDT,0))
- +24 ;specimen
- SET NHITM("resulted")=$PIECE(LR0,U,3)
- SET X=+$PIECE(LR0,U,5)
- IF X
- Begin DoDot:4
- +25 NEW IENS,NHY
- SET IENS=X_","
- +26 DO GETS^DIQ(61,IENS,".01:2",,"NHY")
- +27 ;SNOMED^name
- SET NHITM("specimen")=$GET(NHY(61,IENS,2))_U_$GET(NHY(61,IENS,.01))
- +28 ;name
- SET NHITM("sample")=$$GET1^DIQ(61,X_",",4.1)
- End DoDot:4
- +29 SET NHITM("groupName")=$PIECE(LR0,U,6)
- SET X=+$PIECE(LR0,U,14)
- +30 if X
- SET NHITM("facility")=$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U)
- +31 ;local stn#^name
- IF 'X
- SET NHITM("facility")=$$FAC^NHINV
- +32 SET NHI=0
- FOR
- SET NHI=$ORDER(NHLRO(NHT,NHI))
- if NHI<1
- QUIT
- Begin DoDot:4
- +33 SET X=$GET(NHLRO(NHT,NHI))
- +34 if NHSUB="CH"
- SET NHITM("value",NHI)=$$CH(X)
- +35 if NHSUB="MI"
- SET NHITM("value",NHI)=$$MI(X)
- End DoDot:4
- +36 IF $DATA(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT,"N"))
- MERGE CMMT=^("N")
- SET NHITM("comment")=$$STRING^NHINV(.CMMT)
- +37 DO XML(.NHITM)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +38 KILL ^TMP("LRRR",$JOB,DFN)
- +39 QUIT
- +40 ;
- SORT ; -- return NHLRO(PANEL) = CPRS order# ^ panel/test name ^ Lab Order string
- +1 ; NHLRO(PANEL,NHI) = result node
- +2 NEW X0,NUM,ORD,ODT,SN,T,T0,I,NHY,NHLRT
- KILL NHLRO
- +3 ;first
- SET NHI=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT,0))
- SET X0=$GET(^(NHI))
- +4 SET NUM=$PIECE(X0,U,16)
- SET ORD=$PIECE(X0,U,17)
- SET ODT=+$PIECE(9999999-NHIDT,".")
- +5 ; - build NHLRT list of result nodes for each test/panel
- +6 IF ORD
- SET SN=0
- FOR
- SET SN=$ORDER(^LRO(69,"C",ORD,ODT,SN))
- if SN<1
- QUIT
- Begin DoDot:1
- +7 IF $GET(ID)
- IF $PIECE(ID,";",3)'=SN
- QUIT
- +8 SET T=0
- FOR
- SET T=+$ORDER(^LRO(69,ODT,1,SN,2,T))
- if T<1
- QUIT
- Begin DoDot:2
- +9 IF $GET(ID)
- IF T'=$PIECE(ID,";",4)
- QUIT
- +10 SET T0=$GET(^LRO(69,ODT,1,SN,2,T,0))
- +11 ; is test/panel part of same accession?
- +12 if $PIECE(T0,U,5)'=+$PIECE(NUM," ",3)
- QUIT
- +13 if $$GET1^DIQ(68,$PIECE(T0,U,4)_",",.09)'=$PIECE(NUM," ")
- QUIT
- +14 ; expand panel into unit tests
- +15 KILL NHY
- DO EXPAND(+T0,.NHY)
- +16 ;NHLRT(test,panel)=""
- SET I=0
- FOR
- SET I=$ORDER(NHY(I))
- if I<1
- QUIT
- SET NHLRT(I,+T0)=""
- +17 SET NHLRO(+T0)=$PIECE(T0,U,7)_U_$PIECE($GET(^LAB(60,+T0,0)),U)_U_ORD_";"_ODT_";"_SN_";"_T
- End DoDot:2
- End DoDot:1
- if $DATA(NHLRT)
- QUIT
- +18 ;no Lab Order
- if '$DATA(NHLRO)
- SET NHLRO(0)=$SELECT(NHSUB="MI":"^MICROBIOLOGY^MI;",1:"^ACCESSION^CH;")_NHIDT
- +19 ; - build NHLRO(panel#,NHI) = ^TMP node
- +20 SET NHI=0
- FOR
- SET NHI=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",NHIDT,NHI))
- if NHI<1
- QUIT
- SET X0=$GET(^(NHI))
- Begin DoDot:1
- +21 ;no Lab Order
- IF '$DATA(NHLRT(+X0))
- SET NHLRO(0,NHI)=X0
- QUIT
- +22 SET T=0
- FOR
- SET T=$ORDER(NHLRT(+X0,T))
- if T<1
- QUIT
- SET NHLRO(T,NHI)=X0
- End DoDot:1
- +23 QUIT
- +24 ;
- EXPAND(TEST,ARAY) ;Expand a lab test panel [LR7OU1]
- +1 ;TEST=Test ptr to file 60
- +2 ;Expanded panel returned in ARAY(TEST)
- +3 NEW INARAY
- +4 DO EX(TEST)
- +5 MERGE ARAY=INARAY
- +6 QUIT
- EX(TST) ;
- +1 NEW J,X,SUB
- +2 if '$DATA(^LAB(60,TST,0))
- QUIT
- SET SUB=$PIECE(^(0),"^",5)
- +3 IF $LENGTH(SUB)
- if '$DATA(INARAY(+TST))
- SET INARAY(+TST)=""
- QUIT
- +4 SET J=0
- FOR
- SET J=$ORDER(^LAB(60,+TST,2,J))
- if J<1
- QUIT
- SET X=^(J,0)
- DO EX(+X)
- +5 QUIT
- +6 ;
- ACC(NUM,ODT,SN) ; -- Return 1 or 0, if Specimen entry matches accession
- +1 NEW T,T0,Y
- SET Y=0
- +2 SET T=+$ORDER(^LRO(69,ODT,1,SN,2,0))
- SET T0=$GET(^(T,0))
- +3 IF $PIECE(T0,U,5)=+$PIECE(NUM," ",3)
- IF $$GET1^DIQ(68,$PIECE(T0,U,4)_",",.09)=$PIECE(NUM," ")
- SET Y=1
- +4 QUIT Y
- +5 ;
- CH(X0) ; -- return a Chemistry result as:
- +1 ; id^test^result^interpretation^units^low^high^loinc^vuid
- +2 ; Expects X0=^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
- +3 NEW X,Y,NODE,LOINC
- +4 SET NODE=$GET(^LR(LRDFN,"CH",NHIDT,NHI))
- +5 SET X=$PIECE($GET(^LAB(60,+X0,0)),U)
- +6 SET Y="CH;"_NHIDT_";"_NHI_U_X_U_$PIECE(X0,U,2,4)
- +7 SET X=$PIECE(X0,U,5)
- IF $LENGTH(X)
- IF X["-"
- SET X=$TRANSLATE(X,"- ","^")
- SET $PIECE(Y,U,6,7)=X
- +8 SET X=$PIECE($PIECE(NODE,U,3),"!",3)
- if X
- SET LOINC=$$GET1^DIQ(95.3,X_",",.01)
- +9 IF '$GET(LOINC)
- SET X=+$PIECE(X0,U,19)
- if X
- SET LOINC=$$LOINC(+X0,X)
- +10 SET $PIECE(Y,U,8,9)=$GET(LOINC)_U_$$VUID^NHINV(+$GET(LOINC),95.3)
- +11 QUIT Y
- +12 ;
- LOINC(TEST,SPEC) ; -- Look up LOINC code, if not mapped
- +1 NEW Y,LAM,NHIN,IENS
- SET Y=""
- +2 SET TEST=+$GET(TEST)
- SET SPEC=+$GET(SPEC)
- +3 SET LAM=$GET(^LAB(60,TEST,64))
- SET LAM=$SELECT($PIECE(LAM,U,2):$PIECE(LAM,U,2),1:+LAM)
- +4 DO GETS^DIQ(64.01,SPEC_","_LAM_",","30*",,"NHIN")
- +5 SET IENS=$ORDER(NHIN(64.02,""))
- if IENS
- SET Y=$GET(NHIN(64.02,IENS,4))
- +6 if 'Y
- SET Y=$$GET1^DIQ(60.01,SPEC_","_TEST_",",95.3)
- +7 QUIT Y
- +8 ;
- MI(X0) ; -- return a Microbiology result as:
- +1 ; id^test^result^interpretation^units
- +2 ; Expects X0=^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)
- +3 NEW Y
- SET Y=""
- +4 if $LENGTH($PIECE(X0,U))>1
- SET Y="MI;"_NHIDT_";"_NHI_U_$PIECE(X0,U,1,4)
- +5 QUIT Y
- +6 ;
- +7 ; ------------ Return data to middle tier ------------
- +8 ;
- XML(LAB) ; -- Return result as XML in @NHIN@(#)
- +1 NEW ATT,X,Y,I,J,P,NAMES,TAG
- +2 DO ADD("<panel>")
- SET NHINTOTL=$GET(NHINTOTL)+1
- +3 SET ATT=""
- FOR
- SET ATT=$ORDER(LAB(ATT))
- if ATT=""
- QUIT
- Begin DoDot:1
- +4 IF $ORDER(LAB(ATT,0))
- Begin DoDot:2
- +5 DO ADD("<"_ATT_"s>")
- +6 IF ATT="value"
- SET NAMES="id^test^result^interpretation^units^low^high^loinc^vuid^Z"
- +7 IF '$TEST
- SET NAMES="code^name^Z"
- +8 SET I=0
- FOR
- SET I=$ORDER(LAB(ATT,I))
- if I<1
- QUIT
- Begin DoDot:3
- +9 SET X=$GET(LAB(ATT,I))
- SET Y="<"_ATT_" "_$$LOOP_"/>"
- DO ADD(Y)
- End DoDot:3
- +10 DO ADD("</"_ATT_"s>")
- End DoDot:2
- SET Y=""
- QUIT
- +11 SET X=$GET(LAB(ATT))
- SET Y=""
- if '$LENGTH(X)
- QUIT
- +12 IF ATT="comment"
- SET Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">"
- QUIT
- +13 IF X'["^"
- SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
- QUIT
- +14 IF $LENGTH(X)>1
- SET NAMES="code^name^Z"
- SET Y="<"_ATT_" "_$$LOOP_"/>"
- End DoDot:1
- if $LENGTH(Y)
- DO ADD(Y)
- +15 DO ADD("</panel>")
- +16 QUIT
- +17 ;
- LOOP() ; -- build sub-items string from NAMES and X
- +1 NEW STR,P,TAG
- SET STR=""
- +2 FOR P=1:1
- SET TAG=$PIECE(NAMES,U,P)
- if TAG="Z"
- QUIT
- IF $LENGTH($PIECE(X,U,P))
- SET STR=STR_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
- +3 QUIT STR
- +4 ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- +1 SET NHINI=$GET(NHINI)+1
- +2 SET @NHIN@(NHINI)=X
- +3 QUIT
