Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORXU006

RORXU006.m

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