persists LABS vars. try D DPATV^GPLRIMA(1,"LABS")

p/GPLLABS.m

@@ -23,6 +23,14 @@ EXTRACT(LABXML,DFN,LABOUTXML) ; EXTRACT LABS INTO PROVIDED XML TEMPLATE
  ;
  ;
  ;
+ D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
+ S C0CLB=$NA(^TMP("GPLCCR",$J,"LABS")) ; BASE GLB FOR LABS VARS
+ K @C0CLB ; CLEAR OUT OLD VARS IF ANY
+ S C0CSILENT=1 ; SURPRESS LISTING
+ D LIST ; EXTRACT THE VARIABLES
+ Q
+     ;
+GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
  ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
  ; SET UP FOR LAB API CALL
  S C0CPTID=$$SSN^CCRDPT(DFN) ; GET THE SSN FOR THIS PATIENT
@@ -32,26 +40,32 @@ EXTRACT(LABXML,DFN,LABOUTXML) ; EXTRACT LABS INTO PROVIDED XML TEMPLATE
  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
  D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY TO GET EVERYTHING
  S C0CR=$$GCPR^LA7QRY(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
- W "i'm back",!
  Q
-     ;
+ ;
 LIST ; LIST THE HL7 MESSAGE
  ;
  ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
  ; D EXTRACT^GPLLABS(,1,)
+ I '$D(C0CLB) S C0CLB=$NA(^TMP("GPLCCR",$J,"LABS")) ; BASE GLB FOR LABS VARS
  I '$D(C0CSILENT) S C0CSILENT=0
  I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
  I '$D(^KVAI(0)) D SETTBL ; INITIALIZE LAB TABLE
  I ^KBAI(0)'="V1" D SETTBL ; NEED NEWEST VERSION
- I '$D(^TMP("HLS",$J,1)) D EXTRACT(,DFN,) ;EXTRACT IF NOT ALREADY DONE
+ I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
  S C0CTAB=$NA(^KBAI) ; BASE OF OBX TABLE
  S C0CHB=$NA(^TMP("HLS",$J))
  S C0CI=""
+ S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
  F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
  . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
  . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
  . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CSILENT)
  . M XV=C0CVAR ;
+ . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
+ . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
+ . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
+ . . M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
+ . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
  . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
  . . ; RESULTTESTCODEVALUE
  . . ; RESULTTESTDESCRIPTIONTEXT
@@ -73,9 +87,17 @@ LIST ; LIST THE HL7 MESSAGE
  . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
  . . I 'C0CSILENT D  ;
  . . . ZWR XV
+ . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
+ . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
+ . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TESTS")) ; INDENT FOR TEST RESULTS
+ . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
+ . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
+ . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
  . I 'C0CSILENT D  ;
  . . W C0CI," ",C0CTYP,!
  . ; S C0CI=$O(@C0CHB@(C0CI))
+ K ^TMP("GPLRIM","VARS",DFN,"LABS")
+ M ^TMP("GPLRIM","VARS",DFN,"LABS")=@C0CLB
  Q
 LTYP(OSEG,OTYP,OVARA,OC0CSILENT) ;
  S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
@@ -90,7 +112,7 @@ LTYP(OSEG,OTYP,OVARA,OC0CSILENT) ;
  . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
  . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
  . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
- . . S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
+ . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
  . . I 'C0CSILENT D  ; PRINT OUTPUT IF C0CSILENT IS FALSE
  . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
  Q

p/GPLXPATH.m

@@ -438,10 +438,21 @@ H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
  N H2I S H2I=""
  ; W $O(@IHASH@(H2I)),!
  F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
- . ; W H2I_"^"_@IHASH@(H2I),!
  . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
- . . W "GPLZZ",!
+ . . ;W H2I_"^"_@IHASH@(H2I),!
- . . W $NA(@IHASH@(H2I)),!
+ . . N IH,IHI
+ . . S IH=$NA(@IHASH@(H2I)) ;
+ . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
+ . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
+ . . S IHI="" ; INDEX INTO "M" MULTIPLES
+ . . F  S IHI=$O(@IH2@(IHI)) Q:IHI=""  D  ; FOR EACH SUB-MULTIPLE
+ . . . ; W @IH@(IHI)
+ . . . S IH3=$NA(@IH2@(IHI))
+ . . . ; W "HEY",IH3,!
+ . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
+ . . ; W IH,!
+ . . ; W "GPLZZ",!
+ . . ; W $NA(@IHASH@(H2I)),!
  . . Q  ;
  . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
  . ; W @IARYRTN@(0),!