Changeset 264 for ccr/trunk


Ignore:
Timestamp:
Nov 8, 2008, 10:58:15 PM (16 years ago)
Author:
George Lilly
Message:

persists LABS vars. try D DPATVGPLRIMA(1,"LABS")

Location:
ccr/trunk/p
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/GPLLABS.m

    r262 r264  
    2424 ;
    2525 ;
     26 D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
     27 S C0CLB=$NA(^TMP("GPLCCR",$J,"LABS")) ; BASE GLB FOR LABS VARS
     28 K @C0CLB ; CLEAR OUT OLD VARS IF ANY
     29 S C0CSILENT=1 ; SURPRESS LISTING
     30 D LIST ; EXTRACT THE VARIABLES
     31 Q
     32     ;
     33GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
    2634 ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
    2735 ; SET UP FOR LAB API CALL
     
    3341 D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY TO GET EVERYTHING
    3442 S C0CR=$$GCPR^LA7QRY(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
    35  W "i'm back",!
    36  Q
    37      ;
     43 Q
     44 ;
    3845LIST ; LIST THE HL7 MESSAGE
    3946 ;
    4047 ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
    4148 ; D EXTRACT^GPLLABS(,1,)
     49 I '$D(C0CLB) S C0CLB=$NA(^TMP("GPLCCR",$J,"LABS")) ; BASE GLB FOR LABS VARS
    4250 I '$D(C0CSILENT) S C0CSILENT=0
    4351 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
    4452 I '$D(^KVAI(0)) D SETTBL ; INITIALIZE LAB TABLE
    4553 I ^KBAI(0)'="V1" D SETTBL ; NEED NEWEST VERSION
    46  I '$D(^TMP("HLS",$J,1)) D EXTRACT(,DFN,) ;EXTRACT IF NOT ALREADY DONE
     54 I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
    4755 S C0CTAB=$NA(^KBAI) ; BASE OF OBX TABLE
    4856 S C0CHB=$NA(^TMP("HLS",$J))
    4957 S C0CI=""
     58 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
    5059 F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
    5160 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
     
    5362 . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CSILENT)
    5463 . M XV=C0CVAR ;
     64 . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
     65 . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
     66 . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
     67 . . M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
     68 . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
    5569 . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
    5670 . . ; RESULTTESTCODEVALUE
     
    7488 . . I 'C0CSILENT D  ;
    7589 . . . ZWR XV
     90 . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
     91 . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
     92 . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TESTS")) ; INDENT FOR TEST RESULTS
     93 . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
     94 . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
     95 . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
    7696 . I 'C0CSILENT D  ;
    7797 . . W C0CI," ",C0CTYP,!
    7898 . ; S C0CI=$O(@C0CHB@(C0CI))
     99 K ^TMP("GPLRIM","VARS",DFN,"LABS")
     100 M ^TMP("GPLRIM","VARS",DFN,"LABS")=@C0CLB
    79101 Q
    80102LTYP(OSEG,OTYP,OVARA,OC0CSILENT) ;
     
    91113 . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
    92114 . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
    93  . . S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
     115 . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
    94116 . . I 'C0CSILENT D  ; PRINT OUTPUT IF C0CSILENT IS FALSE
    95117 . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
  • ccr/trunk/p/GPLXPATH.m

    r248 r264  
    439439 ; W $O(@IHASH@(H2I)),!
    440440 F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
    441  . ; W H2I_"^"_@IHASH@(H2I),!
    442441 . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
    443  . . W "GPLZZ",!
    444  . . W $NA(@IHASH@(H2I)),!
     442 . . ;W H2I_"^"_@IHASH@(H2I),!
     443 . . N IH,IHI
     444 . . S IH=$NA(@IHASH@(H2I)) ;
     445 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
     446 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
     447 . . S IHI="" ; INDEX INTO "M" MULTIPLES
     448 . . F  S IHI=$O(@IH2@(IHI)) Q:IHI=""  D  ; FOR EACH SUB-MULTIPLE
     449 . . . ; W @IH@(IHI)
     450 . . . S IH3=$NA(@IH2@(IHI))
     451 . . . ; W "HEY",IH3,!
     452 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
     453 . . ; W IH,!
     454 . . ; W "GPLZZ",!
     455 . . ; W $NA(@IHASH@(H2I)),!
    445456 . . Q  ;
    446457 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
Note: See TracChangeset for help on using the changeset viewer.