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

ECU1RPC.m

Go to the documentation of this file.
  1. ECU1RPC ;ALB/ACS - Event Capture Spreadsheet Utilities ;12/5/22 11:45
  1. ;;2.0;EVENT CAPTURE ;**25,30,49,61,131,139,159**;8 May 96;Build 61
  1. ;
  1. ; Reference to ^TMP supported by SACC 2.3.2.5.1
  1. ; Reference to ^XLFSTR in ICR #10104
  1. ;
  1. ;----------------------------------------------------------------------
  1. ;
  1. ;INPUT ECDATA - Contains column headers or a row of Event Capture
  1. ; spreadshet data
  1. ;
  1. ;
  1. ;OTHER ^TMP($J,"COLS" array will store the column header order
  1. ;
  1. ;----------------------------------------------------------------------
  1. ;======================================================================
  1. ;MODIFICATIONS:
  1. ;
  1. ;08/2001 EC*2.0*30 Changed column header from 'Station' to
  1. ; 'Location'.
  1. ;08/2016 EC*2.0*131 Added many new columns
  1. ;======================================================================
  1. ;
  1. ECHDRS(ECDATA) ;
  1. ;
  1. ;--kill temporary file
  1. K ^TMP($J,"COLS")
  1. N PIECENUM,NUMCOLS
  1. ;
  1. ; --Set up column header order
  1. S NUMCOLS=$L(ECDATA,U)
  1. ;
  1. ; --Remove first piece "COLHEADERS" from colum header string--
  1. S ECDATA=$P(ECDATA,U,2,NUMCOLS)
  1. S NUMCOLS=$L(ECDATA,U)
  1. ;
  1. ; --Spin through each piece in string and assign 'piece' value
  1. F PIECENUM=1:1 Q:PIECENUM>NUMCOLS D
  1. . S DATA=$P(ECDATA,U,PIECENUM)
  1. . I DATA["Record Num" S ECRECPC=PIECENUM Q
  1. . I DATA["Location" S ECSTAPC=PIECENUM Q
  1. . I DATA["SSN" S ECSSNPC=PIECENUM Q
  1. . I DATA["Pat LName" S ECPATLPC=PIECENUM Q
  1. . I DATA["Pat FName" S ECPATFPC=PIECENUM Q
  1. . I DATA["Unit Name" S ECDSSPC=PIECENUM Q
  1. . I DATA["DSS Department" S ECDCMPC=PIECENUM Q ;139 Updated column header name
  1. . I DATA["Unit IEN" S ECUNITPC=PIECENUM Q
  1. . I DATA["Proc" S ECPROCPC=PIECENUM Q
  1. . I DATA["Volume" S ECVOLPC=PIECENUM Q
  1. . I DATA["Ordering Sect" S ECOSPC=PIECENUM Q
  1. . I DATA["Prov 1" S ECPRV1PC=PIECENUM Q ;131
  1. . I DATA["Prov 2" S ECPRV2PC=PIECENUM Q ;131
  1. . I DATA["Prov 3" S ECPRV3PC=PIECENUM Q ;131
  1. . I DATA["Prov 4" S ECPRV4PC=PIECENUM Q ;131
  1. . I DATA["Prov 5" S ECPRV5PC=PIECENUM Q ;131
  1. . I DATA["Prov 6" S ECPRV6PC=PIECENUM Q ;131
  1. . I DATA["Prov 7" S ECPRV7PC=PIECENUM Q ;131
  1. . I DATA["Date/Time" S ECENCPC=PIECENUM Q
  1. . I DATA["Category" S ECCATPC=PIECENUM Q
  1. . I DATA["Diag" S ECDXPC=PIECENUM Q
  1. . I DATA["Sec Dx 1" S ECSEC1PC=PIECENUM Q ;159
  1. . I DATA["Sec Dx 2" S ECSEC2PC=PIECENUM Q ;159
  1. . I DATA["Sec Dx 3" S ECSEC3PC=PIECENUM Q ;159
  1. . I DATA["Sec Dx 4" S ECSEC4PC=PIECENUM Q ;159
  1. . I DATA["Assoc Clin Name" S ECCLNNPC=PIECENUM Q ;131
  1. . I DATA["Assoc Clin IEN" S ECCLNIPC=PIECENUM Q ;131
  1. . I DATA["Mod 1" S ECMOD1PC=PIECENUM Q ;131
  1. . I DATA["Mod 2" S ECMOD2PC=PIECENUM Q ;131
  1. . I DATA["Mod 3" S ECMOD3PC=PIECENUM Q ;131
  1. . I DATA["Mod 4" S ECMOD4PC=PIECENUM Q ;131
  1. . I DATA["Mod 5" S ECMOD5PC=PIECENUM Q ;131
  1. . I DATA["Agent" S ECAOPC=PIECENUM Q ;131
  1. . I DATA["Ion" S ECIRPC=PIECENUM Q ;131
  1. . I DATA["Service" S ECSCPC=PIECENUM Q ;131
  1. . I DATA["SW A" S ECSWAPC=PIECENUM Q ;131
  1. . I DATA["Mil Sexual" S ECMSTPC=PIECENUM Q ;131
  1. . I DATA["Head" S ECHNCPC=PIECENUM Q ;131
  1. . I DATA["Combat" S ECCVPC=PIECENUM Q ;131
  1. . I DATA["SHAD" S ECSHADPC=PIECENUM Q ;131
  1. . I DATA["Camp" S ECCLPC=PIECENUM Q ;131
  1. . ;
  1. . I DATA["Pat Stat" S ECPSTATV=+DATA Q
  1. . I DATA["Override Deceased" S ECDECPAT=+DATA Q
  1. . I DATA["Override Duplicate" S ECFILDUP=+DATA
  1. ;
  1. ;--Move column header piece numbers into Temp file ^TMP($J,"COLS")
  1. ; for future reference
  1. ;
  1. K ^TMP($J,"COLS")
  1. S ^TMP($J,"COLS","ECRECPC")=ECRECPC
  1. S ^TMP($J,"COLS","ECSTAPC")=ECSTAPC
  1. S ^TMP($J,"COLS","ECSSNPC")=ECSSNPC
  1. S ^TMP($J,"COLS","ECPATLPC")=ECPATLPC
  1. S ^TMP($J,"COLS","ECPATFPC")=ECPATFPC
  1. S ^TMP($J,"COLS","ECDSSPC")=ECDSSPC
  1. S ^TMP($J,"COLS","ECDCMPC")=ECDCMPC
  1. S ^TMP($J,"COLS","ECUNITPC")=ECUNITPC
  1. S ^TMP($J,"COLS","ECPROCPC")=ECPROCPC
  1. S ^TMP($J,"COLS","ECVOLPC")=ECVOLPC
  1. S ^TMP($J,"COLS","ECOSPC")=ECOSPC
  1. S ^TMP($J,"COLS","ECPRV1PC")=ECPRV1PC ;131
  1. S ^TMP($J,"COLS","ECENCPC")=ECENCPC
  1. S ^TMP($J,"COLS","ECCATPC")=ECCATPC
  1. S ^TMP($J,"COLS","ECDXPC")=ECDXPC
  1. S ^TMP($J,"COLS","ECSEC1PC")=ECSEC1PC ;159
  1. S ^TMP($J,"COLS","ECSEC2PC")=ECSEC2PC ;159
  1. S ^TMP($J,"COLS","ECSEC3PC")=ECSEC3PC ;159
  1. S ^TMP($J,"COLS","ECSEC4PC")=ECSEC4PC ;159
  1. S ^TMP($J,"COLS","ECCLNNPC")=ECCLNNPC ;131
  1. ;131 New entries added here
  1. S ^TMP($J,"COLS","ECCLNIPC")=ECCLNIPC
  1. S ^TMP($J,"COLS","ECMOD1PC")=ECMOD1PC
  1. S ^TMP($J,"COLS","ECMOD2PC")=ECMOD2PC
  1. S ^TMP($J,"COLS","ECMOD3PC")=ECMOD3PC
  1. S ^TMP($J,"COLS","ECMOD4PC")=ECMOD4PC
  1. S ^TMP($J,"COLS","ECMOD5PC")=ECMOD5PC
  1. S ^TMP($J,"COLS","ECAOPC")=ECAOPC
  1. S ^TMP($J,"COLS","ECIRPC")=ECIRPC
  1. S ^TMP($J,"COLS","ECSCPC")=ECSCPC
  1. S ^TMP($J,"COLS","ECSWAPC")=ECSWAPC
  1. S ^TMP($J,"COLS","ECMSTPC")=ECMSTPC
  1. S ^TMP($J,"COLS","ECHNCPC")=ECHNCPC
  1. S ^TMP($J,"COLS","ECCVPC")=ECCVPC
  1. S ^TMP($J,"COLS","ECSHADPC")=ECSHADPC
  1. S ^TMP($J,"COLS","ECCLPC")=ECCLPC
  1. S ^TMP($J,"COLS","ECPRV2PC")=ECPRV2PC
  1. S ^TMP($J,"COLS","ECPRV3PC")=ECPRV3PC
  1. S ^TMP($J,"COLS","ECPRV4PC")=ECPRV4PC
  1. S ^TMP($J,"COLS","ECPRV5PC")=ECPRV5PC
  1. S ^TMP($J,"COLS","ECPRV6PC")=ECPRV6PC
  1. S ^TMP($J,"COLS","ECPRV7PC")=ECPRV7PC
  1. S ^TMP($J,"COLS","ECPSTATV")=ECPSTATV
  1. S ^TMP($J,"COLS","ECDECPAT")=ECDECPAT
  1. S ^TMP($J,"COLS","ECFILDUP")=ECFILDUP
  1. ;
  1. Q
  1. ;
  1. GETDATA(ECDATA) ;
  1. ;
  1. N NUM ;131
  1. ;--Get data piece numbers and uploaded data values
  1. S ECRECPC=$G(^TMP($J,"COLS","ECRECPC"))
  1. S ECRECV=$P(ECDATA,U,ECRECPC)
  1. ;
  1. S ECSTAPC=$G(^TMP($J,"COLS","ECSTAPC"))
  1. S ECSTAV=$P(ECDATA,U,ECSTAPC)
  1. ;
  1. S ECSSNPC=$G(^TMP($J,"COLS","ECSSNPC"))
  1. I ECSSNPC S ECSSNV=$P(ECDATA,U,ECSSNPC)
  1. ;
  1. S ECPATLPC=$G(^TMP($J,"COLS","ECPATLPC"))
  1. S ECPATLV=$$UP^XLFSTR($P(ECDATA,U,ECPATLPC)) ;131 Convert to upper case
  1. ;
  1. S ECPATFPC=$G(^TMP($J,"COLS","ECPATFPC"))
  1. S ECPATFV=$$UP^XLFSTR($P(ECDATA,U,ECPATFPC)) ;131 Convert to upper case
  1. ; --concatenate patient name into one string, comma separated
  1. S ECPATV=ECPATLV_","_ECPATFV
  1. ;
  1. S ECDSSPC=$G(^TMP($J,"COLS","ECDSSPC"))
  1. S ECDSSV=$P(ECDATA,U,ECDSSPC)
  1. ;
  1. S ECDCMPC=$G(^TMP($J,"COLS","ECDCMPC"))
  1. S ECDCMV=$P(ECDATA,U,ECDCMPC)
  1. ;
  1. S ECUNITPC=$G(^TMP($J,"COLS","ECUNITPC"))
  1. S ECUNITV=$P(ECDATA,U,ECUNITPC)
  1. ;
  1. S ECPROCPC=$G(^TMP($J,"COLS","ECPROCPC"))
  1. S ECPROCV=$P(ECDATA,U,ECPROCPC)
  1. ;
  1. S ECVOLPC=$G(^TMP($J,"COLS","ECVOLPC"))
  1. S ECVOLV=$P(ECDATA,U,ECVOLPC)
  1. ;
  1. S ECOSPC=$G(^TMP($J,"COLS","ECOSPC"))
  1. S ECOSV=$P(ECDATA,U,ECOSPC)
  1. ;Get all the provider values
  1. ;
  1. F NUM=1:1:7 S @("ECPRV"_NUM_"V")=$$UP^XLFSTR($P(ECDATA,U,$G(^TMP($J,"COLS",("ECPRV"_NUM_"PC"))))),@("ECPRV"_NUM_"PC")=$G(^TMP($J,"COLS",("ECPRV"_NUM_"PC"))) ;131
  1. ;
  1. S ECENCPC=$G(^TMP($J,"COLS","ECENCPC"))
  1. S ECENCV=$P(ECDATA,U,ECENCPC),ECENCV=$TR(ECENCV," ","")
  1. ;
  1. S ECCATPC=$G(^TMP($J,"COLS","ECCATPC"))
  1. S ECCATV=$P(ECDATA,U,ECCATPC)
  1. ;
  1. S ECDXPC=$G(^TMP($J,"COLS","ECDXPC"))
  1. S ECDXV=$P(ECDATA,U,ECDXPC)
  1. ;
  1. ; Secondary Diagnoses added for Patch 159
  1. S ECSEC1PC=$G(^TMP($J,"COLS","ECSEC1PC"))
  1. S ECSEC1V=$P(ECDATA,U,ECSEC1PC)
  1. S ECSEC2PC=$G(^TMP($J,"COLS","ECSEC2PC"))
  1. S ECSEC2V=$P(ECDATA,U,ECSEC2PC)
  1. S ECSEC3PC=$G(^TMP($J,"COLS","ECSEC3PC"))
  1. S ECSEC3V=$P(ECDATA,U,ECSEC3PC)
  1. S ECSEC4PC=$G(^TMP($J,"COLS","ECSEC4PC"))
  1. S ECSEC4V=$P(ECDATA,U,ECSEC4PC)
  1. ;
  1. S ECCLNNPC=$G(^TMP($J,"COLS","ECCLNNPC")) ;131
  1. S ECCLNNV=$P(ECDATA,U,ECCLNNPC) ;131
  1. S ECCLNIV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECCLNIPC"))),ECCLNIPC=$G(^TMP($J,"COLS","ECCLNIPC")) ;131
  1. ;
  1. ;Get all CPT Mod values
  1. F NUM=1:1:5 S @("ECMOD"_NUM_"V")=$$UP^XLFSTR($P(ECDATA,U,$G(^TMP($J,"COLS",("ECMOD"_NUM_"PC"))))),@("ECMOD"_NUM_"PC")=$G(^TMP($J,"COLS",("ECMOD"_NUM_"PC"))) ;131
  1. ;
  1. ;131, all patient eligibilities added in this section
  1. S ECAOV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECAOPC"))),ECAOPC=$G(^TMP($J,"COLS","ECAOPC"))
  1. S ECIRV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECIRPC"))),ECIRPC=$G(^TMP($J,"COLS","ECIRPC"))
  1. S ECSCV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECSCPC"))),ECSCPC=$G(^TMP($J,"COLS","ECSCPC"))
  1. S ECSWAV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECSWAPC"))),ECSWAPC=$G(^TMP($J,"COLS","ECSWAPC"))
  1. S ECMSTV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECMSTPC"))),ECMSTPC=$G(^TMP($J,"COLS","ECMSTPC"))
  1. S ECHNCV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECHNCPC"))),ECHNCPC=$G(^TMP($J,"COLS","ECHNCPC"))
  1. S ECCVV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECCVPC"))),ECCVPC=$G(^TMP($J,"COLS","ECCVPC"))
  1. S ECSHADV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECSHADPC"))),ECSHADPC=$G(^TMP($J,"COLS","ECSHADPC"))
  1. S ECCLV=$P(ECDATA,U,$G(^TMP($J,"COLS","ECCLPC"))),ECCLPC=$G(^TMP($J,"COLS","ECCLPC"))
  1. ;
  1. S ECPSTATV=$G(^TMP($J,"COLS","ECPSTATV"))
  1. ;
  1. S ECDECPAT=$G(^TMP($J,"COLS","ECDECPAT"))
  1. ;
  1. S ECFILDUP=$G(^TMP($J,"COLS","ECFILDUP"))
  1. ;
  1. END Q