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 Apr 09, 2024@21:20:16 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
