Changeset 264
- Timestamp:
- Nov 8, 2008, 10:58:15 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/GPLLABS.m
r262 r264 24 24 ; 25 25 ; 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 ; 33 GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT 26 34 ; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR 27 35 ; SET UP FOR LAB API CALL … … 33 41 D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY TO GET EVERYTHING 34 42 S C0CR=$$GCPR^LA7QRY(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP 35 W "i'm back",! 36 Q 37 ; 43 Q 44 ; 38 45 LIST ; LIST THE HL7 MESSAGE 39 46 ; 40 47 ; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR 41 48 ; D EXTRACT^GPLLABS(,1,) 49 I '$D(C0CLB) S C0CLB=$NA(^TMP("GPLCCR",$J,"LABS")) ; BASE GLB FOR LABS VARS 42 50 I '$D(C0CSILENT) S C0CSILENT=0 43 51 I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT 44 52 I '$D(^KVAI(0)) D SETTBL ; INITIALIZE LAB TABLE 45 53 I ^KBAI(0)'="V1" D SETTBL ; NEED NEWEST VERSION 46 I '$D(^TMP("HLS",$J,1)) D EXTRACT(,DFN,) ;EXTRACTIF NOT ALREADY DONE54 I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE 47 55 S C0CTAB=$NA(^KBAI) ; BASE OF OBX TABLE 48 56 S C0CHB=$NA(^TMP("HLS",$J)) 49 57 S C0CI="" 58 S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT 50 59 F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG 51 60 . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES … … 53 62 . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CSILENT) 54 63 . 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 55 69 . I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3 56 70 . . ; RESULTTESTCODEVALUE … … 74 88 . . I 'C0CSILENT D ; 75 89 . . . 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 76 96 . I 'C0CSILENT D ; 77 97 . . W C0CI," ",C0CTYP,! 78 98 . ; S C0CI=$O(@C0CHB@(C0CI)) 99 K ^TMP("GPLRIM","VARS",DFN,"LABS") 100 M ^TMP("GPLRIM","VARS",DFN,"LABS")=@C0CLB 79 101 Q 80 102 LTYP(OSEG,OTYP,OVARA,OC0CSILENT) ; … … 91 113 . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX 92 114 . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE 93 . . S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE115 . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE 94 116 . . I 'C0CSILENT D ; PRINT OUTPUT IF C0CSILENT IS FALSE 95 117 . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,! -
ccr/trunk/p/GPLXPATH.m
r248 r264 439 439 ; W $O(@IHASH@(H2I)),! 440 440 F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH 441 . ; W H2I_"^"_@IHASH@(H2I),!442 441 . 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)),! 445 456 . . Q ; 446 457 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
Note:
See TracChangeset
for help on using the changeset viewer.