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 Dec 13, 2024@02:44:09 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 ;
