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