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

VBECDCU.m

Go to the documentation of this file.
  1. VBECDCU ;hoifo/gjc-data conversion & pre-implementation utilities;Nov 21, 2002
  1. ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1. ;
  1. ;Medical Device #:
  1. ;Note: The food and Drug Administration classifies this software as a
  1. ;medical device. As such, it may not be changed in any way.
  1. ;Modifications to this software may result in an adulterated medical
  1. ;device under 21CFR820, the use of which is considered to be a
  1. ;violation of US Federal Statutes. Acquiring and implementing this
  1. ;software through the Freedom of Information Act requires the
  1. ;implementer to assume total responsibility for the software, and
  1. ;become a registered manufacturer of a medical device, subject to FDA
  1. ;regulations.
  1. ;
  1. ;Call to $$GTF^%ZISH is supported by IA: 2320
  1. ;Call to $$EXTERNAL^DILFD is supported by IA: 2055
  1. ;Call to GETS^DIQ is supported by IA: 2056
  1. ;Call to GETICN^MPIF001 is supported by IA: 2701
  1. ;Call to $$FMTE^XLFDT is supported by IA: 10103
  1. ;Call to SETUP^XQALERT is supported by IA: 10081
  1. ;Call to GETS^DIQ is supported by IA: 10060
  1. ;Call to ^DIR is supported by IA: 10026
  1. ;Call to $$FMADD^XLFDT is supported by IA: 10103
  1. ;
  1. GTF(VBECGR,VBECIS,VBECF) ; save off data stored in a global to a VMS
  1. ; or NT/2000 file.
  1. ; input: VBECGR=global reference
  1. ; VBECIS=Identifies the incrementing subscript level. For
  1. ; example, if you pass ^TMP(115,1,1,0) as the global
  1. ; reference parameter, and pass 3 as the incr_subsc
  1. ; parameter, $$GTF will increment the third subscript,
  1. ; ^TMP(115,1,x), but will read nodes at the full global
  1. ; reference ^TMP(115,1,x,0).
  1. ; VBECF=Name of the file where the data is to reside.
  1. ; output: 1=success, 0=failure
  1. ;
  1. ; Here's an example (from the Hines development account) on how the
  1. ; the call works: S Y=$$GTF^%ZISH($NA(^TMP("VBEC NP",$J,1,0)),3,
  1. ; "SYS$USER:[CEBE]","ZZNP.TXT")
  1. S VBECP=$P($G(^VBEC(6000,1,0)),U,6) ; VBECP=file path
  1. ;
  1. Q $$GTF^%ZISH(VBECGR,VBECIS,VBECP,VBECF)
  1. ;
  1. DELETE(VBECY) ; purge the ^TMP("VBEC*",$J) global
  1. ; input: VBECY=$J or process id, or zero to kill along all processes.
  1. S VBECY=+$G(VBECY),VBECX="VBEC FINI"
  1. F S VBECX=$O(^TMP(VBECX)) Q:VBECX=""!(VBECX]"VBEC63 zzz") D Q:'VBECYN
  1. .I '$D(VBECYN)#2 D Q:'VBECYN
  1. ..K DIR,DTOUT,DUOUT,DIRUT
  1. ..S DIR(0)="Y",DIR("A")="Are you sure you want to delete the temporary globals"
  1. ..S DIR("B")="No",DIR("?")="Answer 'Yes' to delete globals, or 'No' forgo global deletion." D ^DIR S VBECYN=Y
  1. ..S:$D(DIRUT)#2 VBECYN=0
  1. ..Q
  1. .W !,"Killing ^TMP("""_VBECX_""""
  1. .W $S(VBECY>0:","_VBECY_")",1:")")
  1. .K:VBECY ^TMP(VBECX,VBECY) K:'VBECY ^TMP(VBECX)
  1. .H 1
  1. .Q
  1. W:'$D(VBECYN)#2 !!,"No data to delete."
  1. W:$D(VBECYN)#2 !!,"Done..." K VBECX,VBECY,VBECYN,X,Y
  1. Q
  1. ;
  1. NP200(IEN) ; gather New Person information in order to populate
  1. ; the appropriate SQL Server table on the VBECS side.
  1. ; Name, SSN, Termination Date, & Division are the attributes returned.
  1. ; Input: IEN the internal entry number of the New Person record.
  1. ; We'll be saving New Person (NP) data off in ^TMP("VBEC NP",$J) and
  1. ; plan to create our NP VMS file after all other VMS files are closed.
  1. Q:IEN=""!(+IEN'=IEN) K LRARY N LRSTR
  1. S LRTRMDT="" D GETS^DIQ(200,IEN_",",".01;9;9.2;16*","EI","LRARY")
  1. S LRNAME=LRARY(200,IEN_",",.01,"E")
  1. S LRSSN=LRARY(200,IEN_",",9,"E") S:LRSSN="" LRSSN="*"
  1. Q:($D(^TMP("VBECX NP",$J,IEN,LRNAME,LRSSN)))#2 ; data already exists
  1. S:LRARY(200,IEN_",",9.2,"I")'="" LRTRMDT=$$DATE(LRARY(200,IEN_",",9.2,"I"))
  1. I ($D(LRARY(200.02))\10) D
  1. .S LRA="" F S LRA=$O(LRARY(200.02,LRA)) Q:LRA="" D
  1. ..S DIVPTR=LRARY(200.02,LRA,.01,"I")
  1. ..S DIVNAME=LRARY(200.02,LRA,.01,"E")
  1. ..S CNT=$$CNT("VBEC NP",$J),CNT=CNT+1
  1. ..S LRSTR=IEN_"^"_LRNAME_"^"_LRSSN_"^"_LRTRMDT_"^"_DIVPTR_"^"_DIVNAME
  1. ..S VBECTOT("VBEC NP")=+$G(VBECTOT("VBEC NP"))+1
  1. ..S ^TMP("VBEC NP",$J,CNT,0)=LRSTR_$C(13)
  1. ..S ^TMP("VBECX NP",$J,IEN,LRNAME,LRSSN)=""
  1. ..Q
  1. .Q
  1. E D
  1. .S CNT=$$CNT("VBEC NP",$J),CNT=CNT+1
  1. .S LRSTR=IEN_"^"_LRNAME_"^"_LRSSN_"^"_"^"_LRTRMDT_"^^"
  1. .S VBECTOT("VBEC NP")=+$G(VBECTOT("VBEC NP"))+1
  1. .S ^TMP("VBEC NP",$J,CNT,0)=LRSTR_$C(13)
  1. .S ^TMP("VBECX NP",$J,IEN,LRNAME,LRSSN)=""
  1. .Q
  1. K CNT,DIVNAME,DIVPTR,LRA,LRNAME,LRSSN,LRTRMDT ; LRTRMDT=termination date
  1. K LRARY Q
  1. ;
  1. XTRNL(LRFL,LRFD,LRFLG,LRINT) ; change data from its internal value
  1. ; to its external value.
  1. ; LRFL-file or subfile number LRFLD-field number
  1. ; LRFLG-Output transform for pointer data. 'F' if the first field
  1. ; in a pointer chain has a output transform, apply the transform
  1. ; & quit. 'L' if the last field in a pointer chain has a output
  1. ; transform, apply the transform & quit. 'U' if the first field
  1. ; in a pointer chain has a output transform, apply the transform
  1. ; to the last field in the pointer chain & quit.
  1. ; function documented @ VA FileMan v22 Programmer Manual pg:2-171
  1. ; LRINT-the internal value being converted.
  1. Q $$EXTERNAL^DILFD(LRFL,LRFD,LRFLG,LRINT)
  1. ;
  1. DATE(LRDATE) ; date/time transformed. Initial format created in order to
  1. ; handle an individual's date of birth, input in 'LRDATE', formatted
  1. ; 'mm/dd/yy<sp>time'.
  1. ;
  1. ; check for midnight date/time (yyymmdd.24) and convert it to
  1. ; a valid SQL Server date/time. Example: if date/time is: 3030715.24
  1. ; convert to: 3030715.235959
  1. I $P(LRDATE,".",2)=24 S LRDATE=$$FMADD^XLFDT(LRDATE,0,0,0,-1)
  1. ;
  1. S LRMTH="^Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
  1. S LRDATE=$$FMTE^XLFDT(LRDATE,1),LRDATE=$TR(LRDATE,",","")
  1. S LRDATE=$TR(LRDATE,$P(LRDATE," "),$L($P(LRMTH,U_$P(LRDATE," ")),U))
  1. S LRDATE=$TR($P(LRDATE,"@")," ","/")_$S(LRDATE["@":"@"_$P(LRDATE,"@",2),1:"")
  1. Q $TR(LRDATE,"@"," ")
  1. ;
  1. ALERT(DUZ,TSK,FLG,ABN) ;trigger an alert when the pre-implementation or
  1. ;data conversion finishes.
  1. ;Input: DUZ-The user initiating these tasks, and ultimately informed
  1. ; when the process completes.
  1. ; TSK-The task being executed; either the pre-implementation or
  1. ; the data conversion. '1' implies data conversion, '0'
  1. ; implies the pre-implementation
  1. ; FLG-status of data conversion: >0=anomalies, 0=no anomalies
  1. ; ABN-flag to indicate if abnormal conditions exist, specifically
  1. ; if the user stopped the process via TaskMan, or if data to
  1. ; convert does not exist. Input will be -1 for no data, and
  1. ; "S" if the user stopped the process.
  1. ;
  1. K XQA,XQAMSG,XQAROU S XQA(DUZ)=""
  1. S XQAMSG="VBECS "_$S(TSK=0:"Anomaly Check",1:"Data Conversion")_" complete"
  1. S:ABN=-1 XQAMSG=XQAMSG_", data non-existent"
  1. S:ABN="S" XQAMSG=XQAMSG_", user terminated"
  1. I FLG=0 S XQAMSG=XQAMSG_", anomalies non-existent."
  1. I FLG>0 S XQAMSG=XQAMSG_", anomalies identified."
  1. D SETUP^XQALERT K XQA,XQAMSG,XQAROU
  1. Q
  1. ;
  1. RPT(TSK) ;report header
  1. ; Input: TSK-The task being executed; either the pre-implementation or
  1. ; the data conversion. 'DC' implies data conversion, 'PI'
  1. ; implies the pre-implementation
  1. W:$E(IOST,1,2)="C-" @IOF
  1. S $P(VBECLN,"-",(IOM+1))=""
  1. W !,"VBECS "_$S(TSK="DC"=1:"data conversion",1:"pre-implementation")_" process",?$S(IOM=132:117,1:65),"Page 1 of 1",VBECLN
  1. Q
  1. ;
  1. CNT(X,Y) ; return the value of a subscript
  1. ; Input: X=the name of the subscript, i.e., "VBEC63 DEM"
  1. ; Y=$J
  1. Q +$O(^TMP(X,Y,999999999999),-1)
  1. ;
  1. SWAP(LRF,LRP) ; swap the VistA pointer (or free-text blood supplier) data for
  1. ; the SQL GUID equivalent. In the case that the entry is not mapped
  1. ; (VistA pointer has no corresponding SQL Server GUID), this utility
  1. ; returns null.
  1. ; input: LRF=file being mapped
  1. ; LRP=VistA pointer value (IEN or record 'pointed to')
  1. ;return: null or a valid GUID
  1. ;
  1. Q:LRF="" "" Q:LRP="" "" N VBEC6005,VBEC6007
  1. I LRF'=66.01 S VBEC6005=$O(^VBEC(6005,"B",LRF_"-"_LRP,""))
  1. E S VBEC6005=$O(^VBEC(6005,"AA",LRF,LRP,""))
  1. Q:VBEC6005="" ""
  1. S VBEC6007=$P($G(^VBEC(6005,VBEC6005,0)),U,5)
  1. Q:VBEC6007="" ""
  1. Q $P($G(^VBEC(6007,VBEC6007,0)),U,3)
  1. ;
  1. BLUT(Y) ; obtain ABO GROUP (#.05) & RH TYPE (#.06) from Lab Data (#63) file
  1. S Y("ABO")=$P($G(^LR(Y,0)),U,5),Y("RH")=$E($P($G(^LR(Y,0)),U,6),1)
  1. ; note: we're interested 'n' for negative & 'p' for positive (1 char)
  1. Q Y("ABO")_U_Y("RH")
  1. ;
  1. ICN(DFN) ; obtain the patient's ICN. DFN is input, and either the ICN,
  1. ; if it exists, or null will be returned.
  1. ; APIs used by this subroutine (in extrinsic function $$ICN)
  1. ; #2701-$$GETICN^MPIF001(DFN), this function returns the ICN
  1. S LRICN="" ; default to null
  1. I ($T(GETICN^MPIF001)'="") D
  1. .; the $$GETICN^MPIF001 returns delimited data. If the ICN exists,
  1. .; it's returned as ICN_'V'_ICN checksum. If it doesn't exist, it's
  1. .; returned as -1_'^'_error message. We change -1 to null for SQL
  1. .S LRICN=$$GETICN^MPIF001(DFN),LRICN=$S($P(LRICN,"^")="-1":"",1:LRICN)
  1. .Q
  1. Q LRICN
  1. ;