- LRFRSLT ;AITC/CR - LAB DATA FUNCTION API WRAPPER ; 10/25/17 3:46pm
- ;;5.2;LAB SERVICE;**476**;Sep 27, 1994;Build 11
- ; This routine is used by the FileMan function LRRESULT to generate a
- ; report of verified lab tests for multiple patients over a given
- ; date range
- ;
- GETLAB(MDAYS,TEST,SPEC,DFN) ; Custom lab lookup API for results
- ; MDAYS = # of days to look back for verified lab test results
- ; TEST = IEN for a given lab test, file #60
- ; SPEC = IEN for a given specimen, file #61
- ; DFN = IEN for patient, file #2
- ;
- N LRBGDT,RESULT,LDATE,UNITS
- N X,X1,X2
- Q:'+$G(TEST) ""
- Q:'+$G(DFN) ""
- S MDAYS=$G(MDAYS,365)
- S X1=DT,X2=-$G(MDAYS) D C^%DTC
- S LRBGDT=$S(X<DT:X,1:0)
- D RR^LR7OR1(DFN,,LRBGDT,DT,,TEST,,1,$G(SPEC))
- D FORMAT
- I $G(RESULT)']"" Q "NONE FOUND IN LAST "_+$S(+MDAYS:MDAYS,1:365)_" DAYS"
- Q RESULT_" "_UNITS_";"_$$FMTE^XLFDT(LDATE,2)
- ;
- FORMAT N IDT,LOC,NODE
- S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,"CH",IDT)) Q:'+IDT D
- . S LOC=0 F S LOC=$O(^TMP("LRRR",$J,DFN,"CH",IDT,LOC)) Q:'+LOC D
- .. S NODE=$G(^TMP("LRRR",$J,DFN,"CH",IDT,LOC))
- .. S RESULT=$P(NODE,U,2)
- .. S UNITS=$P(NODE,U,4)
- .. S LDATE=9999999-IDT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRFRSLT 1173 printed Mar 13, 2025@21:19:11 Page 2
- LRFRSLT ;AITC/CR - LAB DATA FUNCTION API WRAPPER ; 10/25/17 3:46pm
- +1 ;;5.2;LAB SERVICE;**476**;Sep 27, 1994;Build 11
- +2 ; This routine is used by the FileMan function LRRESULT to generate a
- +3 ; report of verified lab tests for multiple patients over a given
- +4 ; date range
- +5 ;
- GETLAB(MDAYS,TEST,SPEC,DFN) ; Custom lab lookup API for results
- +1 ; MDAYS = # of days to look back for verified lab test results
- +2 ; TEST = IEN for a given lab test, file #60
- +3 ; SPEC = IEN for a given specimen, file #61
- +4 ; DFN = IEN for patient, file #2
- +5 ;
- +6 NEW LRBGDT,RESULT,LDATE,UNITS
- +7 NEW X,X1,X2
- +8 if '+$GET(TEST)
- QUIT ""
- +9 if '+$GET(DFN)
- QUIT ""
- +10 SET MDAYS=$GET(MDAYS,365)
- +11 SET X1=DT
- SET X2=-$GET(MDAYS)
- DO C^%DTC
- +12 SET LRBGDT=$SELECT(X<DT:X,1:0)
- +13 DO RR^LR7OR1(DFN,,LRBGDT,DT,,TEST,,1,$GET(SPEC))
- +14 DO FORMAT
- +15 IF $GET(RESULT)']""
- QUIT "NONE FOUND IN LAST "_+$SELECT(+MDAYS:MDAYS,1:365)_" DAYS"
- +16 QUIT RESULT_" "_UNITS_";"_$$FMTE^XLFDT(LDATE,2)
- +17 ;
- FORMAT NEW IDT,LOC,NODE
- +1 SET IDT=0
- FOR
- SET IDT=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IDT))
- if '+IDT
- QUIT
- Begin DoDot:1
- +2 SET LOC=0
- FOR
- SET LOC=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IDT,LOC))
- if '+LOC
- QUIT
- Begin DoDot:2
- +3 SET NODE=$GET(^TMP("LRRR",$JOB,DFN,"CH",IDT,LOC))
- +4 SET RESULT=$PIECE(NODE,U,2)
- +5 SET UNITS=$PIECE(NODE,U,4)
- +6 SET LDATE=9999999-IDT
- End DoDot:2
- End DoDot:1
- +7 QUIT