RORXU006 ;HCIOFO/SG - REPORT PARAMETERS ;6/21/06 1:41pm
;;1.5;CLINICAL CASE REGISTRIES;**1,13,21,31,33,34**;Feb 17, 2006;Build 45
;
; This routine uses the following IAs:
;
; #91 Read access to the file #60 (controlled)
; #417 The .01 field of file #40.8 (controlled)
; #2947 ATESTS^ORWLRR (controlled)
; #10035 Direct read of DOD field of file #2 (supported)
; #10040 Read access to HOSPITAL LOCATION file (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*13 DEC 2010 A SAUNDERS Moved code in tags CLINLST and DIVLST to
; PARMS^RORXU002 so the clinic or
; division XML will be returned for all
; reports.
; NOTE: Patch 11 became patch 13.
; Any references to patch 11 in the code
; below is referring to path 13.
;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
;
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional
; identifiers.
;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
;******************************************************************************
;******************************************************************************
Q
;
;***** PROCESSES THE LIST OF CLINICS
;
; .RORTSK Task number and task parameters
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the CLINICS element
;
CLINLST(RORTSK,PARTAG) ;
Q 0 ;code removed for patch 11
N IEN,LTAG,RORMSG,TMP
I $D(RORTSK("PARAMS","CLINICS","C"))>1 D
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CLINICS",,PARTAG) Q:LTAG'>0
. S IEN=0
. F S IEN=$O(RORTSK("PARAMS","CLINICS","C",IEN)) Q:IEN'>0 D
. . S TMP=$$GET1^DIQ(44,IEN_",",.01,,,"RORMSG")
. . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,44,IEN_",")
. . Q:TMP=""
. . D ADDVAL^RORTSK11(RORTSK,"CLINIC",TMP,LTAG,,IEN)
E D:$$PARAM^RORTSK01("CLINICS","ALL")
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CLINICS","ALL",PARTAG)
Q +$G(LTAG)
;
;***** PROCESSES THE LIST OF CPT CODES
;
; .RORTSK Task number and task parameters
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the CPTLST element
;
CPTLST(RORTSK,PARTAG) ;
N CPT,IEN,LTAG,TMP
I $D(RORTSK("PARAMS","CPTLST","C"))>1 D
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CPTLST",,PARTAG) Q:LTAG'>0
. S IEN=0
. F S IEN=$O(RORTSK("PARAMS","CPTLST","C",IEN)) Q:IEN'>0 D
. . S CPT=$P(RORTSK("PARAMS","CPTLST","C",IEN),U) Q:CPT=""
. . D ADDVAL^RORTSK11(RORTSK,"CPT",CPT,LTAG,,IEN)
E D:$$PARAM^RORTSK01("CPTLST","ALL")
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"CPTLST","ALL",PARTAG)
Q +$G(LTAG)
;
;***** PROCESSES THE LIST OF DIVISIONS
;
; .RORTSK Task number and task parameters
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the DIVISIONS element
;
DIVLST(RORTSK,PARTAG) ;
Q 0 ;code removed for patch 11
N IEN,LTAG,RORMSG,TMP
I $D(RORTSK("PARAMS","DIVISIONS","C"))>1 D
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DIVISIONS",,PARTAG) Q:LTAG'>0
. S IEN=0
. F S IEN=$O(RORTSK("PARAMS","DIVISIONS","C",IEN)) Q:IEN'>0 D
. . S TMP=$$GET1^DIQ(40.8,IEN_",",.01,,,"RORMSG")
. . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,40.8,IEN_",")
. . Q:TMP=""
. . D ADDVAL^RORTSK11(RORTSK,"DIVISION",TMP,LTAG,,IEN)
E D:$$PARAM^RORTSK01("DIVISIONS","ALL")
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"DIVISIONS","ALL",PARTAG)
Q +$G(LTAG)
;
;***** PROCESSES THE LIST OF LAB TESTS
;
; .RORTSK Task number and task parameters
;
; PARTAG Reference (IEN) to the parent tag
;
;
; .ROR8LST Reference to a local variable, which contains a
; closed root of an array. Descriptors of selected
; lab tests will be returned into this array.
;
; @ROR8LTST@(ResultNode,TestIEN)
; ^01: Test IEN (in file #60)
; ^02: Test name
; ^03: 99
; ^04: "Other"
; ^05: Location subscript
; ^06: Result node
;
; If this parameter is undefined or empty, then a
; temporary buffer is allocated by the $$ALLOC^RORTMP
; function and its root is returned via this parameter.
;
; If all drugs are requested (the "ALL" attribute of
; the "DRUGS" tag), then "*" is returned.
;
; [ROR8LRG] Closed root of a node where the lab tests with
; defined range values will be returned. By default
; ($G(ROR8LRG)=""), this list is not compiled.
;
; @ROR8LRG@(TestIEN,
; "H") = Low
; "L") = High
;
; "H", "L", or both will be defined.
;
; If the source list contains lab test panels, all corresponding
; lab tests are added to the @ROR8LST array but only a single tag
; is added to the XML list.
;
; Return Values:
; <0 Error code
; >0 IEN of the LABTESTS element
;
LTLST(RORTSK,PARTAG,ROR8LST,ROR8LRG) ;
N ALL,BUF,I,LTAG,LTIEN,LTOPTS,TMP
S ALL=+$$PARAM^RORTSK01("LABTESTS","ALL")
S (LTAG,RC)=0
;
;=== Validate parameters
I 'ALL D K @ROR8LST
. S:$G(ROR8LST)="" ROR8LST=$$ALLOC^RORTMP()
E S ROR8LST="*"
;
;=== Process the drug options (if present)
M LTOPTS=RORTSK("PARAMS","LABTESTS","A")
I $D(LTOPTS)>1 D Q:LTAG'>0 LTAG
. N ATTR,REGIEN
. S ATTR=$S(ALL:"ALL",1:"")
. S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",ATTR,PARTAG)
. Q:LTAG'>0
. ;--- Output option attributes
. S ATTR="",RC=0
. F S ATTR=$O(LTOPTS(ATTR)) Q:ATTR="" D Q:RC<0
. . S RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
. I RC<0 S LTAG=RC Q
. S ATTR=$$OPTXT^RORXU002(.LTOPTS)
. D:ATTR'="" ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
;
;=== Process the list of tests (if present)
I 'ALL,$D(RORTSK("PARAMS","LABTESTS","C"))>1 D
. I LTAG'>0 D Q:LTAG'>0
. . S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,PARTAG)
. S LTIEN=0
. F S LTIEN=$O(RORTSK("PARAMS","LABTESTS","C",LTIEN)) Q:LTIEN'>0 D
. . D LTLSTI(LTIEN,LTAG)
;
Q $S(RC<0:RC,1:LTAG)
;
;***** CREATES THE LAB TEST ITEM(S)
;
; LTIEN IEN of the lab test in the file #60
; [LTAG] IEN of the parent tag
;
; This is an internal entry point. Do NOT call it directly.
;
LTLSTI(LTIEN,LTAG) ;
N BUF,I,IENS,ITEM,LTNAME,LTNODE,PLTCNT,RORBUF,RORMSG,TMP
;--- Load the lab test parameters
S IENS=LTIEN_","
D GETS^DIQ(60,IENS,".01;5","EI","RORBUF","RORMSG")
D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,60,IENS)
S LTNAME=$G(RORBUF(60,IENS,.01,"E")) Q:LTNAME=""
;--- Output the tag and update the list of ranges
D:$G(LTAG)>0
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",LTNAME,LTAG,,LTIEN)
. S TMP=$$UP^XLFSTR($G(RORTSK("PARAMS","LABTESTS","C",LTIEN,"L")))
. D:TMP'=""
. . D ADDATTR^RORTSK11(RORTSK,ITEM,"LOW",TMP)
. . S:$G(ROR8LRG)'="" @ROR8LRG@(LTIEN,"L")=TMP
. S TMP=$$UP^XLFSTR($G(RORTSK("PARAMS","LABTESTS","C",LTIEN,"H")))
. D:TMP'=""
. . D ADDATTR^RORTSK11(RORTSK,ITEM,"HIGH",TMP)
. . S:$G(ROR8LRG)'="" @ROR8LRG@(LTIEN,"H")=TMP
;--- Process the panel
D ATESTS^ORWLRR(.BUF,LTIEN)
I $D(BUF)>1 S I="",PLTCNT=0 D Q:PLTCNT>1
. F S I=$O(BUF(I)) Q:I="" D
. . S TMP=+$P(BUF(I),U),PLTCNT=PLTCNT+1
. . D:TMP'=LTIEN LTLSTI(TMP)
;--- Create the reference
S LTNODE=$P($G(RORBUF(60,IENS,5,"I")),";",2) Q:LTNODE=""
S BUF=LTIEN_U_LTNAME_U_"99^Other"
S $P(BUF,U,5)=$P(RORBUF(60,IENS,5,"I"),";") ; Subscript
S $P(BUF,U,6)=LTNODE ; Result node
S @ROR8LST@(LTNODE,LTIEN)=BUF
Q
;
;***** CHECKS IF THE OPTIONAL COLUMN IS SELECTED
;
; NAME Column name
;
; Return Values:
; 0 Skip the field
; >0 Include in report
;
OPTCOL(NAME) ;
Q $S($G(NAME)'="":$D(RORTSK("PARAMS","OPTIONAL_COLUMNS","C",NAME)),1:0)
;
;***** CHECK IF ONLY THE SUMMARY SHOULD BE GENERATED
SMRYONLY() ;
Q:$$PARAM^RORTSK01("MAXUTNUM")'="" 0
Q:$$PARAM^RORTSK01("MINRPNUM")'="" 0
Q 1
;
;***** OUTPUTS ICN DATA IF ICN SHOULD BE THE FINAL COLUMN
; TASK Task number
;
; VALUE DFN of patient
;
; PARENT IEN of the parent element
;
ICNDATA(TASK,VALUE,PARENT) ;
N TMP
S TMP=$$ICN^RORUTL02(VALUE)
I TMP'<0 D ADDVAL^RORTSK11(TASK,"ICN",TMP,PARENT,1)
Q
;
PACTDATA(TASK,VALUE,PARENT) ;
N TMP
S TMP=$$PACT^RORUTL02(VALUE)
I TMP'<0 D ADDVAL^RORTSK11(TASK,"PACT",TMP,PARENT,1)
Q
;
PCPDATA(TASK,VALUE,PARENT) ;
N TMP
S TMP=$$PCP^RORUTL02(VALUE)
I TMP'<0 D ADDVAL^RORTSK11(TASK,"PCP",TMP,PARENT,1)
Q
FUTAPPT(TASK,DFN,DAYS,PARENT) ; PATCH 33
N TMP,FUTAPPT,FUTCLIN
S TMP=0
S TMP=$$FUTAPPT^RORUTL02(DFN,DAYS)
I TMP'<0 D
. D ADDVAL^RORTSK11(TASK,"FUT_APPT",$P(TMP,U),PARENT,1)
. D ADDVAL^RORTSK11(TASK,"FUT_CLIN",$P(TMP,U,2),PARENT,1) ;PATCH 34
;. D ADDATTR^RORTSK11(TASK,$P(TMP,U,2),"NAME","FUT_CLIN") ;PATCH 34
;. D ADDATTR^RORTSK11(TASK,$P(TMP,U),"NAME","FUT_APPT")
Q
;
;***** OUTPUTS ICN HEADER IF ICN SHOULD BE THE FINAL COLUMN
; TASK Task number
;
; PARENT IEN of the parent element
;
ICNHDR(TASK,PARENT) ;
N TMP
S TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
D ADDATTR^RORTSK11(TASK,TMP,"NAME","ICN")
Q
;
PACTHDR(TASK,PARENT) ;
N TMP
S TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
D ADDATTR^RORTSK11(TASK,TMP,"NAME","PACT")
Q
;
PCPHDR(TASK,PARENT) ;
N TMP
S TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
D ADDATTR^RORTSK11(TASK,TMP,"NAME","PCP")
Q
;
APPTHDR(TASK,PARENT) ;
N TMP
S TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
D ADDATTR^RORTSK11(TASK,TMP,"NAME","FUT_APPT")
S TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
D ADDATTR^RORTSK11(TASK,TMP,"NAME","FUT_CLIN") ; PATCH 34
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU006 10576 printed Apr 09, 2024@20:47:42 Page 2
RORXU006 ;HCIOFO/SG - REPORT PARAMETERS ;6/21/06 1:41pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,13,21,31,33,34**;Feb 17, 2006;Build 45
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #91 Read access to the file #60 (controlled)
+6 ; #417 The .01 field of file #40.8 (controlled)
+7 ; #2947 ATESTS^ORWLRR (controlled)
+8 ; #10035 Direct read of DOD field of file #2 (supported)
+9 ; #10040 Read access to HOSPITAL LOCATION file (supported)
+10 ;
+11 ;******************************************************************************
+12 ;******************************************************************************
+13 ; --- ROUTINE MODIFICATION LOG ---
+14 ;
+15 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+16 ;----------- ---------- ----------- ----------------------------------------
+17 ;ROR*1.5*13 DEC 2010 A SAUNDERS Moved code in tags CLINLST and DIVLST to
+18 ; PARMS^RORXU002 so the clinic or
+19 ; division XML will be returned for all
+20 ; reports.
+21 ; NOTE: Patch 11 became patch 13.
+22 ; Any references to patch 11 in the code
+23 ; below is referring to path 13.
+24 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+25 ;
+26 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT and PCP as additional
+27 ; identifiers.
+28 ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
+29 ;******************************************************************************
+30 ;******************************************************************************
+31 QUIT
+32 ;
+33 ;***** PROCESSES THE LIST OF CLINICS
+34 ;
+35 ; .RORTSK Task number and task parameters
+36 ;
+37 ; PARTAG Reference (IEN) to the parent tag
+38 ;
+39 ; Return Values:
+40 ; <0 Error code
+41 ; >0 IEN of the CLINICS element
+42 ;
CLINLST(RORTSK,PARTAG) ;
+1 ;code removed for patch 11
QUIT 0
+2 NEW IEN,LTAG,RORMSG,TMP
+3 IF $DATA(RORTSK("PARAMS","CLINICS","C"))>1
Begin DoDot:1
+4 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"CLINICS",,PARTAG)
if LTAG'>0
QUIT
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(RORTSK("PARAMS","CLINICS","C",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+7 SET TMP=$$GET1^DIQ(44,IEN_",",.01,,,"RORMSG")
+8 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,44,IEN_",")
+9 if TMP=""
QUIT
+10 DO ADDVAL^RORTSK11(RORTSK,"CLINIC",TMP,LTAG,,IEN)
End DoDot:2
End DoDot:1
+11 IF '$TEST
if $$PARAM^RORTSK01("CLINICS","ALL")
Begin DoDot:1
+12 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"CLINICS","ALL",PARTAG)
End DoDot:1
+13 QUIT +$GET(LTAG)
+14 ;
+15 ;***** PROCESSES THE LIST OF CPT CODES
+16 ;
+17 ; .RORTSK Task number and task parameters
+18 ;
+19 ; PARTAG Reference (IEN) to the parent tag
+20 ;
+21 ; Return Values:
+22 ; <0 Error code
+23 ; >0 IEN of the CPTLST element
+24 ;
CPTLST(RORTSK,PARTAG) ;
+1 NEW CPT,IEN,LTAG,TMP
+2 IF $DATA(RORTSK("PARAMS","CPTLST","C"))>1
Begin DoDot:1
+3 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"CPTLST",,PARTAG)
if LTAG'>0
QUIT
+4 SET IEN=0
+5 FOR
SET IEN=$ORDER(RORTSK("PARAMS","CPTLST","C",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+6 SET CPT=$PIECE(RORTSK("PARAMS","CPTLST","C",IEN),U)
if CPT=""
QUIT
+7 DO ADDVAL^RORTSK11(RORTSK,"CPT",CPT,LTAG,,IEN)
End DoDot:2
End DoDot:1
+8 IF '$TEST
if $$PARAM^RORTSK01("CPTLST","ALL")
Begin DoDot:1
+9 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"CPTLST","ALL",PARTAG)
End DoDot:1
+10 QUIT +$GET(LTAG)
+11 ;
+12 ;***** PROCESSES THE LIST OF DIVISIONS
+13 ;
+14 ; .RORTSK Task number and task parameters
+15 ;
+16 ; PARTAG Reference (IEN) to the parent tag
+17 ;
+18 ; Return Values:
+19 ; <0 Error code
+20 ; >0 IEN of the DIVISIONS element
+21 ;
DIVLST(RORTSK,PARTAG) ;
+1 ;code removed for patch 11
QUIT 0
+2 NEW IEN,LTAG,RORMSG,TMP
+3 IF $DATA(RORTSK("PARAMS","DIVISIONS","C"))>1
Begin DoDot:1
+4 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"DIVISIONS",,PARTAG)
if LTAG'>0
QUIT
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(RORTSK("PARAMS","DIVISIONS","C",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+7 SET TMP=$$GET1^DIQ(40.8,IEN_",",.01,,,"RORMSG")
+8 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,40.8,IEN_",")
+9 if TMP=""
QUIT
+10 DO ADDVAL^RORTSK11(RORTSK,"DIVISION",TMP,LTAG,,IEN)
End DoDot:2
End DoDot:1
+11 IF '$TEST
if $$PARAM^RORTSK01("DIVISIONS","ALL")
Begin DoDot:1
+12 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"DIVISIONS","ALL",PARTAG)
End DoDot:1
+13 QUIT +$GET(LTAG)
+14 ;
+15 ;***** PROCESSES THE LIST OF LAB TESTS
+16 ;
+17 ; .RORTSK Task number and task parameters
+18 ;
+19 ; PARTAG Reference (IEN) to the parent tag
+20 ;
+21 ;
+22 ; .ROR8LST Reference to a local variable, which contains a
+23 ; closed root of an array. Descriptors of selected
+24 ; lab tests will be returned into this array.
+25 ;
+26 ; @ROR8LTST@(ResultNode,TestIEN)
+27 ; ^01: Test IEN (in file #60)
+28 ; ^02: Test name
+29 ; ^03: 99
+30 ; ^04: "Other"
+31 ; ^05: Location subscript
+32 ; ^06: Result node
+33 ;
+34 ; If this parameter is undefined or empty, then a
+35 ; temporary buffer is allocated by the $$ALLOC^RORTMP
+36 ; function and its root is returned via this parameter.
+37 ;
+38 ; If all drugs are requested (the "ALL" attribute of
+39 ; the "DRUGS" tag), then "*" is returned.
+40 ;
+41 ; [ROR8LRG] Closed root of a node where the lab tests with
+42 ; defined range values will be returned. By default
+43 ; ($G(ROR8LRG)=""), this list is not compiled.
+44 ;
+45 ; @ROR8LRG@(TestIEN,
+46 ; "H") = Low
+47 ; "L") = High
+48 ;
+49 ; "H", "L", or both will be defined.
+50 ;
+51 ; If the source list contains lab test panels, all corresponding
+52 ; lab tests are added to the @ROR8LST array but only a single tag
+53 ; is added to the XML list.
+54 ;
+55 ; Return Values:
+56 ; <0 Error code
+57 ; >0 IEN of the LABTESTS element
+58 ;
LTLST(RORTSK,PARTAG,ROR8LST,ROR8LRG) ;
+1 NEW ALL,BUF,I,LTAG,LTIEN,LTOPTS,TMP
+2 SET ALL=+$$PARAM^RORTSK01("LABTESTS","ALL")
+3 SET (LTAG,RC)=0
+4 ;
+5 ;=== Validate parameters
+6 IF 'ALL
Begin DoDot:1
+7 if $GET(ROR8LST)=""
SET ROR8LST=$$ALLOC^RORTMP()
End DoDot:1
KILL @ROR8LST
+8 IF '$TEST
SET ROR8LST="*"
+9 ;
+10 ;=== Process the drug options (if present)
+11 MERGE LTOPTS=RORTSK("PARAMS","LABTESTS","A")
+12 IF $DATA(LTOPTS)>1
Begin DoDot:1
+13 NEW ATTR,REGIEN
+14 SET ATTR=$SELECT(ALL:"ALL",1:"")
+15 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",ATTR,PARTAG)
+16 if LTAG'>0
QUIT
+17 ;--- Output option attributes
+18 SET ATTR=""
SET RC=0
+19 FOR
SET ATTR=$ORDER(LTOPTS(ATTR))
if ATTR=""
QUIT
Begin DoDot:2
+20 SET RC=$$ADDATTR^RORTSK11(RORTSK,LTAG,ATTR,"1")
End DoDot:2
if RC<0
QUIT
+21 IF RC<0
SET LTAG=RC
QUIT
+22 SET ATTR=$$OPTXT^RORXU002(.LTOPTS)
+23 if ATTR'=""
DO ADDATTR^RORTSK11(RORTSK,LTAG,"DESCR",ATTR)
End DoDot:1
if LTAG'>0
QUIT LTAG
+24 ;
+25 ;=== Process the list of tests (if present)
+26 IF 'ALL
IF $DATA(RORTSK("PARAMS","LABTESTS","C"))>1
Begin DoDot:1
+27 IF LTAG'>0
Begin DoDot:2
+28 SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,PARTAG)
End DoDot:2
if LTAG'>0
QUIT
+29 SET LTIEN=0
+30 FOR
SET LTIEN=$ORDER(RORTSK("PARAMS","LABTESTS","C",LTIEN))
if LTIEN'>0
QUIT
Begin DoDot:2
+31 DO LTLSTI(LTIEN,LTAG)
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT $SELECT(RC<0:RC,1:LTAG)
+34 ;
+35 ;***** CREATES THE LAB TEST ITEM(S)
+36 ;
+37 ; LTIEN IEN of the lab test in the file #60
+38 ; [LTAG] IEN of the parent tag
+39 ;
+40 ; This is an internal entry point. Do NOT call it directly.
+41 ;
LTLSTI(LTIEN,LTAG) ;
+1 NEW BUF,I,IENS,ITEM,LTNAME,LTNODE,PLTCNT,RORBUF,RORMSG,TMP
+2 ;--- Load the lab test parameters
+3 SET IENS=LTIEN_","
+4 DO GETS^DIQ(60,IENS,".01;5","EI","RORBUF","RORMSG")
+5 if $GET(DIERR)
DO DBS^RORERR("RORMSG",-9,,,60,IENS)
+6 SET LTNAME=$GET(RORBUF(60,IENS,.01,"E"))
if LTNAME=""
QUIT
+7 ;--- Output the tag and update the list of ranges
+8 if $GET(LTAG)>0
Begin DoDot:1
+9 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",LTNAME,LTAG,,LTIEN)
+10 SET TMP=$$UP^XLFSTR($GET(RORTSK("PARAMS","LABTESTS","C",LTIEN,"L")))
+11 if TMP'=""
Begin DoDot:2
+12 DO ADDATTR^RORTSK11(RORTSK,ITEM,"LOW",TMP)
+13 if $GET(ROR8LRG)'=""
SET @ROR8LRG@(LTIEN,"L")=TMP
End DoDot:2
+14 SET TMP=$$UP^XLFSTR($GET(RORTSK("PARAMS","LABTESTS","C",LTIEN,"H")))
+15 if TMP'=""
Begin DoDot:2
+16 DO ADDATTR^RORTSK11(RORTSK,ITEM,"HIGH",TMP)
+17 if $GET(ROR8LRG)'=""
SET @ROR8LRG@(LTIEN,"H")=TMP
End DoDot:2
End DoDot:1
+18 ;--- Process the panel
+19 DO ATESTS^ORWLRR(.BUF,LTIEN)
+20 IF $DATA(BUF)>1
SET I=""
SET PLTCNT=0
Begin DoDot:1
+21 FOR
SET I=$ORDER(BUF(I))
if I=""
QUIT
Begin DoDot:2
+22 SET TMP=+$PIECE(BUF(I),U)
SET PLTCNT=PLTCNT+1
+23 if TMP'=LTIEN
DO LTLSTI(TMP)
End DoDot:2
End DoDot:1
if PLTCNT>1
QUIT
+24 ;--- Create the reference
+25 SET LTNODE=$PIECE($GET(RORBUF(60,IENS,5,"I")),";",2)
if LTNODE=""
QUIT
+26 SET BUF=LTIEN_U_LTNAME_U_"99^Other"
+27 ; Subscript
SET $PIECE(BUF,U,5)=$PIECE(RORBUF(60,IENS,5,"I"),";")
+28 ; Result node
SET $PIECE(BUF,U,6)=LTNODE
+29 SET @ROR8LST@(LTNODE,LTIEN)=BUF
+30 QUIT
+31 ;
+32 ;***** CHECKS IF THE OPTIONAL COLUMN IS SELECTED
+33 ;
+34 ; NAME Column name
+35 ;
+36 ; Return Values:
+37 ; 0 Skip the field
+38 ; >0 Include in report
+39 ;
OPTCOL(NAME) ;
+1 QUIT $SELECT($GET(NAME)'="":$DATA(RORTSK("PARAMS","OPTIONAL_COLUMNS","C",NAME)),1:0)
+2 ;
+3 ;***** CHECK IF ONLY THE SUMMARY SHOULD BE GENERATED
SMRYONLY() ;
+1 if $$PARAM^RORTSK01("MAXUTNUM")'=""
QUIT 0
+2 if $$PARAM^RORTSK01("MINRPNUM")'=""
QUIT 0
+3 QUIT 1
+4 ;
+5 ;***** OUTPUTS ICN DATA IF ICN SHOULD BE THE FINAL COLUMN
+6 ; TASK Task number
+7 ;
+8 ; VALUE DFN of patient
+9 ;
+10 ; PARENT IEN of the parent element
+11 ;
ICNDATA(TASK,VALUE,PARENT) ;
+1 NEW TMP
+2 SET TMP=$$ICN^RORUTL02(VALUE)
+3 IF TMP'<0
DO ADDVAL^RORTSK11(TASK,"ICN",TMP,PARENT,1)
+4 QUIT
+5 ;
PACTDATA(TASK,VALUE,PARENT) ;
+1 NEW TMP
+2 SET TMP=$$PACT^RORUTL02(VALUE)
+3 IF TMP'<0
DO ADDVAL^RORTSK11(TASK,"PACT",TMP,PARENT,1)
+4 QUIT
+5 ;
PCPDATA(TASK,VALUE,PARENT) ;
+1 NEW TMP
+2 SET TMP=$$PCP^RORUTL02(VALUE)
+3 IF TMP'<0
DO ADDVAL^RORTSK11(TASK,"PCP",TMP,PARENT,1)
+4 QUIT
FUTAPPT(TASK,DFN,DAYS,PARENT) ; PATCH 33
+1 NEW TMP,FUTAPPT,FUTCLIN
+2 SET TMP=0
+3 SET TMP=$$FUTAPPT^RORUTL02(DFN,DAYS)
+4 IF TMP'<0
Begin DoDot:1
+5 DO ADDVAL^RORTSK11(TASK,"FUT_APPT",$PIECE(TMP,U),PARENT,1)
+6 ;PATCH 34
DO ADDVAL^RORTSK11(TASK,"FUT_CLIN",$PIECE(TMP,U,2),PARENT,1)
End DoDot:1
+7 ;. D ADDATTR^RORTSK11(TASK,$P(TMP,U,2),"NAME","FUT_CLIN") ;PATCH 34
+8 ;. D ADDATTR^RORTSK11(TASK,$P(TMP,U),"NAME","FUT_APPT")
+9 QUIT
+10 ;
+11 ;***** OUTPUTS ICN HEADER IF ICN SHOULD BE THE FINAL COLUMN
+12 ; TASK Task number
+13 ;
+14 ; PARENT IEN of the parent element
+15 ;
ICNHDR(TASK,PARENT) ;
+1 NEW TMP
+2 SET TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
+3 DO ADDATTR^RORTSK11(TASK,TMP,"NAME","ICN")
+4 QUIT
+5 ;
PACTHDR(TASK,PARENT) ;
+1 NEW TMP
+2 SET TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
+3 DO ADDATTR^RORTSK11(TASK,TMP,"NAME","PACT")
+4 QUIT
+5 ;
PCPHDR(TASK,PARENT) ;
+1 NEW TMP
+2 SET TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
+3 DO ADDATTR^RORTSK11(TASK,TMP,"NAME","PCP")
+4 QUIT
+5 ;
APPTHDR(TASK,PARENT) ;
+1 NEW TMP
+2 SET TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
+3 DO ADDATTR^RORTSK11(TASK,TMP,"NAME","FUT_APPT")
+4 SET TMP=$$ADDVAL^RORTSK11(TASK,"COLUMN",,PARENT)
+5 ; PATCH 34
DO ADDATTR^RORTSK11(TASK,TMP,"NAME","FUT_CLIN")
+6 QUIT
+7 ;
