- 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 Jan 18, 2025@02:46:23 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 ;