QACI2B ; OAKOIFO/TKW - DATA MIGRATION - BUILD SUPPORTING TABLE DATA ;4/10/06 12:06
;;2.0;Patient Representative;**19**;07/25/1995;Build 55
;
PTDATA(STATION,DFN,QACI0,PATSERR,PATSCNT) ; Put patient data into ^XTMP global for migration
S PATSERR=0
Q:$D(^XTMP("QACMIGR","PT","D",DFN))
Q:$D(^XTMP("QACMIGR","PT","U",DFN))
I $D(^XTMP("QACMIGR","PT","E",DFN)) S PATSERR=1 Q
N PATX,I,X,Y,VAN,VAX,VAV,VADM,VAEL,DSPNAME,PTICN,PTNAME,PATSDATA,PATSDAT2,PATSENRL,GENDER,DOB,RACE,ETH
S (PATSDATA,PATSDAT2)=""
; Get Patient Demographics, load name into variable. (IA #10061)
D DEM^VADPT
S DSPNAME=$G(VADM(1)) I $L(DSPNAME)>30 S DSPNAME=$E(DSPNAME,1,30)_"..."
; Get Patient's Integration Control Number (ICN) (IA #2701)
S PTICN=$P($$GETICN^MPIF001(DFN),"^")
I PTICN]"",PTICN'=-1,PTICN'?1.12N1"V"1.6N S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - ICN invalid")
; Load Parent Station number, Patients IEN (DFN) and ICN into output (node 1)
I 'QACI0 S PATSDATA="1^"_STATION_"^"_DFN_"^"_PTICN_"^"
; Get enrollment priority for current enrollment from file 27.11 (IA #2918)
S PATSENRL=$$GETENRL^QACVDEM(DFN)
; Get Patient Name Components and load into output. (IA #3065)
S PTNAME("FILE")=2,PTNAME("FIELD")=.01,PTNAME("IENS")=DFN
S PTNAME=$$HLNAME^XLFNAME(.PTNAME)
D
. N NMERR S NMERR=0
. I PTNAME'?.ANP S NMERR=1
. S X=$P(PTNAME,"^") I $$TXTERR^QACI2C(X,35,0,1) S NMERR=1
. S X=$P(PTNAME,"^",2) I $$TXTERR^QACI2C(X,25,0,1) S NMERR=1
. S X=$P(PTNAME,"^",3) I $$TXTERR^QACI2C(X,25) S NMERR=1
. F I=4:1:6 I $$TXTERR^QACI2C($P(PTNAME,"^",I),10) S NMERR=1 Q
. I NMERR=1 S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Name invalid")
. Q
I 'QACI0 S PATSDATA=PATSDATA_PTNAME
; Load Gender, date of birth and SSN into output
S GENDER=$P(VADM(5),"^") I GENDER'="M",GENDER'="F" D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Gender invalid") Q
S DOB=$$CONVDATE($P(VADM(3),"^")) D:'DOB
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Date of Birth invalid") Q
S X=$E(VADM(2),1,9) I X]"",X'?9N D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - SSN invalid") Q
I 'QACI0 S $P(PATSDATA,"^",11,14)=GENDER_"^"_DOB_"^"_X_"^0"
S PATX=$E(VADM(2),10) I PATX="P",'QACI0 S $P(PATSDATA,"^",14)=1
; Get eligibility data, load eligibility code and enrollment priority
; period of service, is service connected, svc.connected %
; and category into output (IA #10061)
D ELIG^VADPT
S X=$P(VAEL(1),"^",2)
I $P(VAEL(1),"^"),X="" D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Primary Eligibility Code pointer invalid") Q
I $$TXTERR^QACI2C(X,30) D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Primary Eligibility Code invalid") Q
I 'QACI0 S $P(PATSDATA,"^",15,16)=X_"^"_PATSENRL
; Load period of service, is service connected, svc.connected %
; and category into output node 2.
S X=$P(VAEL(2),"^",2)
I $P(VAEL(2),"^"),X="" D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Period of Service pointer invalid") Q
I $$TXTERR^QACI2C(X,25) D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Period of Service invalid") Q
I 'QACI0 S PATSDAT2="2^"_X
S X=$P(VAEL(3),"^") I X'=1,X'=0 D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Is Service Connected Flag invalid") Q
I 'QACI0 S $P(PATSDAT2,"^",3)=X
S X=$P(VAEL(3),"^",2) D:X]""
. I X'?1.3N!(X<0)!(X>100) S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Service Connected % invalid")
. Q
I 'QACI0 S $P(PATSDAT2,"^",4)=X
; Add CATEGORY (Current Means Test Status)
S X=$P($G(^DPT(DFN,0)),"^",14) I X,'$D(^DG(408.32,X,0)) D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Current Means Test Status pointer invalid") Q
S X=$P(VAEL(9),"^",2)
I X]"",$L(X)>30!(X?.N)!($L(X)<3)!'(X'?1P.E)!(X'?.ANP) D
. S PATSERR=1 D ERREF^QACI2C("PT",DFN,DSPNAME_" - Current Means Test Status invalid") Q
I 'QACI0 S $P(PATSDAT2,"^",5)=X
; Add Ethnicity and Race information to output (IA #3799)
D RACETH^QACVDEM(.VADM,.RACE,.ETH)
I ETH]"" S $P(PATSDAT2,"^",6)=ETH
S X=6
F I=0:0 S I=$O(RACE(I)) Q:'I D
. S X=X+1
. S $P(PATSDAT2,"^",X)=RACE(I)
. Q
; Quit if any errors occurred
I PATSERR=1 Q
; Put data into table for output.
S ^XTMP("QACMIGR","PT","U",DFN)=PATSDATA
S ^XTMP("QACMIGR","PT","U",DFN,"cont")=PATSDAT2
S PATSCNT("PT")=PATSCNT("PT")+1
Q
;
ELIGCAT(ELIGSTAT,CATEGORY,ROC0) ; Get Patient Eligibility Status and Category from ROC
S ELIGSTAT=$P(ROC0,"^",4) D:ELIGSTAT]""
. I $$TXTERR^QACI2C(ELIGSTAT,30) D ERROC^QACI2A(OLDROC,"ELIGIBILITY STATUS is invalid")
. Q
S CATEGORY=$P(ROC0,"^",5) D:CATEGORY]""
. I $$TXTERR^QACI2C(CATEGORY,30) D ERROC^QACI2A(OLDROC,"CATEGORY (current means test) is invalid")
. Q
Q
;
USERDATA(STATION,IEN,USERTYPE,QACI0,PATSERR,PATSCNT) ; Load pats_user data for migration
S PATSERR=0
N UTYPE S UTYPE=$S(USERTYPE="U":"USER",1:"EMPINV")
Q:$D(^XTMP("QACMIGR",UTYPE,"D",IEN))
Q:$D(^XTMP("QACMIGR",UTYPE,"U",IEN))
I $D(^XTMP("QACMIGR",UTYPE,"E",IEN)) S PATSERR=1 Q
N IENS,EMPDATA,DSPNAME,NAMECOMP,NAMEJ,TITLE,MAILCODE,NMERR
S IENS=IEN_",",EMPDATA=""
S DSPNAME=$P($G(^VA(200,+$G(IEN),0)),"^")
I $L(DSPNAME)>30 S DSPNAME=$E(DSPNAME,1,30)_"..."
; Get user name, pointer to name componentents, title and mail code (IA #10060)
I USERTYPE="E" D
. D GETS^DIQ(200,IENS,"8;28","IE","EMPDATA")
. S X=$P($G(^VA(200,IEN,0)),"^",9) I X,'$D(^DIC(3.1,X,0)) D
.. S PATSERR=1 D ERREF^QACI2C("EMPINV",IEN,DSPNAME_" - Title pointer invalid")
. S TITLE=$E($G(EMPDATA(200,IENS,8,"E")),1,30)
. S MAILCODE=$E($G(EMPDATA(200,IENS,28,"E")),1,10)
. I $$TXTERR^QACI2C(TITLE) S PATSERR=1 D ERREF^QACI2C("EMPINV",IEN,DSPNAME_" - Title invalid")
. I $$TXTERR^QACI2C(MAILCODE) S PATSERR=1 D ERREF^QACI2C("EMPINV",IEN,DSPNAME_" - Mail Code invalid")
. Q
; Load User IEN and station number into output
I 'QACI0 S EMPDATA=IEN_"^"_STATION_"^"
; Get name components (IA #3065)
S NAMECOMP("FILE")=200,NAMECOMP("FIELD")=.01,NAMECOMP("IENS")=IENS
S NAMECOMP=$$HLNAME^XLFNAME(.NAMECOMP)
S NMERR=0
F NAMEJ=1:1:6 D
. S X=$P(NAMECOMP,"^",NAMEJ) I NAMEJ>2,X="" Q
. I X'?.ANP S NMERR=1 Q
. I NAMEJ=1,$$TXTERR^QACI2C(X,35,0,1) S NMERR=1 Q
. I NAMEJ=2,$$TXTERR^QACI2C(X,25,0,1) S NMERR=1 Q
. I NAMEJ=3,$$TXTERR^QACI2C(X,25) S NMERR=1 Q
. I NAMEJ>3,$$TXTERR^QACI2C(X,10) S NMERR=1 Q
. I 'QACI0 S $P(EMPDATA,"^",NAMEJ+2)=X
. Q
I NMERR=1 D NAMERR
Q:PATSERR=1
I 'QACI0,USERTYPE="E" S $P(EMPDATA,"^",9)=TITLE,$P(EMPDATA,"^",10)=MAILCODE
S ^XTMP("QACMIGR",UTYPE,"U",IEN)=EMPDATA
S PATSCNT(UTYPE)=PATSCNT(UTYPE)+1
Q
;
CONVDATE(OLDDATE) ; Convert data to MM/DD/YYYY format
N MM,DD S MM=$E(OLDDATE,4,5),DD=$E(OLDDATE,6,7)
S:MM="00" MM="01"
S:DD="00" DD="01"
S OLDDATE=$E(OLDDATE,1,3)_MM_DD
Q $$FMTE^XLFDT(OLDDATE,5)
;
NAMERR ;
N X S X="Name invalid"
I $G(DSPNAME)]"" S X=DSPNAME_" - "_X
S PATSERR=1 D ERREF^QACI2C(UTYPE,IEN,X)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQACI2B 6903 printed Feb 10, 2021@20:59:08 Page 2
QACI2B ; OAKOIFO/TKW - DATA MIGRATION - BUILD SUPPORTING TABLE DATA ;4/10/06 12:06
+1 ;;2.0;Patient Representative;**19**;07/25/1995;Build 55
+2 ;
PTDATA(STATION,DFN,QACI0,PATSERR,PATSCNT) ; Put patient data into ^XTMP global for migration
+1 SET PATSERR=0
+2 if $DATA(^XTMP("QACMIGR","PT","D",DFN))
QUIT
+3 if $DATA(^XTMP("QACMIGR","PT","U",DFN))
QUIT
+4 IF $DATA(^XTMP("QACMIGR","PT","E",DFN))
SET PATSERR=1
QUIT
+5 NEW PATX,I,X,Y,VAN,VAX,VAV,VADM,VAEL,DSPNAME,PTICN,PTNAME,PATSDATA,PATSDAT2,PATSENRL,GENDER,DOB,RACE,ETH
+6 SET (PATSDATA,PATSDAT2)=""
+7 ; Get Patient Demographics, load name into variable. (IA #10061)
+8 DO DEM^VADPT
+9 SET DSPNAME=$GET(VADM(1))
IF $LENGTH(DSPNAME)>30
SET DSPNAME=$EXTRACT(DSPNAME,1,30)_"..."
+10 ; Get Patient's Integration Control Number (ICN) (IA #2701)
+11 SET PTICN=$PIECE($$GETICN^MPIF001(DFN),"^")
+12 IF PTICN]""
IF PTICN'=-1
IF PTICN'?1.12N1"V"1.6N
SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - ICN invalid")
+13 ; Load Parent Station number, Patients IEN (DFN) and ICN into output (node 1)
+14 IF 'QACI0
SET PATSDATA="1^"_STATION_"^"_DFN_"^"_PTICN_"^"
+15 ; Get enrollment priority for current enrollment from file 27.11 (IA #2918)
+16 SET PATSENRL=$$GETENRL^QACVDEM(DFN)
+17 ; Get Patient Name Components and load into output. (IA #3065)
+18 SET PTNAME("FILE")=2
SET PTNAME("FIELD")=.01
SET PTNAME("IENS")=DFN
+19 SET PTNAME=$$HLNAME^XLFNAME(.PTNAME)
+20 Begin DoDot:1
+21 NEW NMERR
SET NMERR=0
+22 IF PTNAME'?.ANP
SET NMERR=1
+23 SET X=$PIECE(PTNAME,"^")
IF $$TXTERR^QACI2C(X,35,0,1)
SET NMERR=1
+24 SET X=$PIECE(PTNAME,"^",2)
IF $$TXTERR^QACI2C(X,25,0,1)
SET NMERR=1
+25 SET X=$PIECE(PTNAME,"^",3)
IF $$TXTERR^QACI2C(X,25)
SET NMERR=1
+26 FOR I=4:1:6
IF $$TXTERR^QACI2C($PIECE(PTNAME,"^",I),10)
SET NMERR=1
QUIT
+27 IF NMERR=1
SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Name invalid")
+28 QUIT
End DoDot:1
+29 IF 'QACI0
SET PATSDATA=PATSDATA_PTNAME
+30 ; Load Gender, date of birth and SSN into output
+31 SET GENDER=$PIECE(VADM(5),"^")
IF GENDER'="M"
IF GENDER'="F"
Begin DoDot:1
+32 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Gender invalid")
QUIT
End DoDot:1
+33 SET DOB=$$CONVDATE($PIECE(VADM(3),"^"))
if 'DOB
Begin DoDot:1
+34 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Date of Birth invalid")
QUIT
End DoDot:1
+35 SET X=$EXTRACT(VADM(2),1,9)
IF X]""
IF X'?9N
Begin DoDot:1
+36 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - SSN invalid")
QUIT
End DoDot:1
+37 IF 'QACI0
SET $PIECE(PATSDATA,"^",11,14)=GENDER_"^"_DOB_"^"_X_"^0"
+38 SET PATX=$EXTRACT(VADM(2),10)
IF PATX="P"
IF 'QACI0
SET $PIECE(PATSDATA,"^",14)=1
+39 ; Get eligibility data, load eligibility code and enrollment priority
+40 ; period of service, is service connected, svc.connected %
+41 ; and category into output (IA #10061)
+42 DO ELIG^VADPT
+43 SET X=$PIECE(VAEL(1),"^",2)
+44 IF $PIECE(VAEL(1),"^")
IF X=""
Begin DoDot:1
+45 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Primary Eligibility Code pointer invalid")
QUIT
End DoDot:1
+46 IF $$TXTERR^QACI2C(X,30)
Begin DoDot:1
+47 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Primary Eligibility Code invalid")
QUIT
End DoDot:1
+48 IF 'QACI0
SET $PIECE(PATSDATA,"^",15,16)=X_"^"_PATSENRL
+49 ; Load period of service, is service connected, svc.connected %
+50 ; and category into output node 2.
+51 SET X=$PIECE(VAEL(2),"^",2)
+52 IF $PIECE(VAEL(2),"^")
IF X=""
Begin DoDot:1
+53 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Period of Service pointer invalid")
QUIT
End DoDot:1
+54 IF $$TXTERR^QACI2C(X,25)
Begin DoDot:1
+55 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Period of Service invalid")
QUIT
End DoDot:1
+56 IF 'QACI0
SET PATSDAT2="2^"_X
+57 SET X=$PIECE(VAEL(3),"^")
IF X'=1
IF X'=0
Begin DoDot:1
+58 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Is Service Connected Flag invalid")
QUIT
End DoDot:1
+59 IF 'QACI0
SET $PIECE(PATSDAT2,"^",3)=X
+60 SET X=$PIECE(VAEL(3),"^",2)
if X]""
Begin DoDot:1
+61 IF X'?1.3N!(X<0)!(X>100)
SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Service Connected % invalid")
+62 QUIT
End DoDot:1
+63 IF 'QACI0
SET $PIECE(PATSDAT2,"^",4)=X
+64 ; Add CATEGORY (Current Means Test Status)
+65 SET X=$PIECE($GET(^DPT(DFN,0)),"^",14)
IF X
IF '$DATA(^DG(408.32,X,0))
Begin DoDot:1
+66 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Current Means Test Status pointer invalid")
QUIT
End DoDot:1
+67 SET X=$PIECE(VAEL(9),"^",2)
+68 IF X]""
IF $LENGTH(X)>30!(X?.N)!($LENGTH(X)<3)!'(X'?1P.E)!(X'?.ANP)
Begin DoDot:1
+69 SET PATSERR=1
DO ERREF^QACI2C("PT",DFN,DSPNAME_" - Current Means Test Status invalid")
QUIT
End DoDot:1
+70 IF 'QACI0
SET $PIECE(PATSDAT2,"^",5)=X
+71 ; Add Ethnicity and Race information to output (IA #3799)
+72 DO RACETH^QACVDEM(.VADM,.RACE,.ETH)
+73 IF ETH]""
SET $PIECE(PATSDAT2,"^",6)=ETH
+74 SET X=6
+75 FOR I=0:0
SET I=$ORDER(RACE(I))
if 'I
QUIT
Begin DoDot:1
+76 SET X=X+1
+77 SET $PIECE(PATSDAT2,"^",X)=RACE(I)
+78 QUIT
End DoDot:1
+79 ; Quit if any errors occurred
+80 IF PATSERR=1
QUIT
+81 ; Put data into table for output.
+82 SET ^XTMP("QACMIGR","PT","U",DFN)=PATSDATA
+83 SET ^XTMP("QACMIGR","PT","U",DFN,"cont")=PATSDAT2
+84 SET PATSCNT("PT")=PATSCNT("PT")+1
+85 QUIT
+86 ;
ELIGCAT(ELIGSTAT,CATEGORY,ROC0) ; Get Patient Eligibility Status and Category from ROC
+1 SET ELIGSTAT=$PIECE(ROC0,"^",4)
if ELIGSTAT]""
Begin DoDot:1
+2 IF $$TXTERR^QACI2C(ELIGSTAT,30)
DO ERROC^QACI2A(OLDROC,"ELIGIBILITY STATUS is invalid")
+3 QUIT
End DoDot:1
+4 SET CATEGORY=$PIECE(ROC0,"^",5)
if CATEGORY]""
Begin DoDot:1
+5 IF $$TXTERR^QACI2C(CATEGORY,30)
DO ERROC^QACI2A(OLDROC,"CATEGORY (current means test) is invalid")
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
USERDATA(STATION,IEN,USERTYPE,QACI0,PATSERR,PATSCNT) ; Load pats_user data for migration
+1 SET PATSERR=0
+2 NEW UTYPE
SET UTYPE=$SELECT(USERTYPE="U":"USER",1:"EMPINV")
+3 if $DATA(^XTMP("QACMIGR",UTYPE,"D",IEN))
QUIT
+4 if $DATA(^XTMP("QACMIGR",UTYPE,"U",IEN))
QUIT
+5 IF $DATA(^XTMP("QACMIGR",UTYPE,"E",IEN))
SET PATSERR=1
QUIT
+6 NEW IENS,EMPDATA,DSPNAME,NAMECOMP,NAMEJ,TITLE,MAILCODE,NMERR
+7 SET IENS=IEN_","
SET EMPDATA=""
+8 SET DSPNAME=$PIECE($GET(^VA(200,+$GET(IEN),0)),"^")
+9 IF $LENGTH(DSPNAME)>30
SET DSPNAME=$EXTRACT(DSPNAME,1,30)_"..."
+10 ; Get user name, pointer to name componentents, title and mail code (IA #10060)
+11 IF USERTYPE="E"
Begin DoDot:1
+12 DO GETS^DIQ(200,IENS,"8;28","IE","EMPDATA")
+13 SET X=$PIECE($GET(^VA(200,IEN,0)),"^",9)
IF X
IF '$DATA(^DIC(3.1,X,0))
Begin DoDot:2
+14 SET PATSERR=1
DO ERREF^QACI2C("EMPINV",IEN,DSPNAME_" - Title pointer invalid")
End DoDot:2
+15 SET TITLE=$EXTRACT($GET(EMPDATA(200,IENS,8,"E")),1,30)
+16 SET MAILCODE=$EXTRACT($GET(EMPDATA(200,IENS,28,"E")),1,10)
+17 IF $$TXTERR^QACI2C(TITLE)
SET PATSERR=1
DO ERREF^QACI2C("EMPINV",IEN,DSPNAME_" - Title invalid")
+18 IF $$TXTERR^QACI2C(MAILCODE)
SET PATSERR=1
DO ERREF^QACI2C("EMPINV",IEN,DSPNAME_" - Mail Code invalid")
+19 QUIT
End DoDot:1
+20 ; Load User IEN and station number into output
+21 IF 'QACI0
SET EMPDATA=IEN_"^"_STATION_"^"
+22 ; Get name components (IA #3065)
+23 SET NAMECOMP("FILE")=200
SET NAMECOMP("FIELD")=.01
SET NAMECOMP("IENS")=IENS
+24 SET NAMECOMP=$$HLNAME^XLFNAME(.NAMECOMP)
+25 SET NMERR=0
+26 FOR NAMEJ=1:1:6
Begin DoDot:1
+27 SET X=$PIECE(NAMECOMP,"^",NAMEJ)
IF NAMEJ>2
IF X=""
QUIT
+28 IF X'?.ANP
SET NMERR=1
QUIT
+29 IF NAMEJ=1
IF $$TXTERR^QACI2C(X,35,0,1)
SET NMERR=1
QUIT
+30 IF NAMEJ=2
IF $$TXTERR^QACI2C(X,25,0,1)
SET NMERR=1
QUIT
+31 IF NAMEJ=3
IF $$TXTERR^QACI2C(X,25)
SET NMERR=1
QUIT
+32 IF NAMEJ>3
IF $$TXTERR^QACI2C(X,10)
SET NMERR=1
QUIT
+33 IF 'QACI0
SET $PIECE(EMPDATA,"^",NAMEJ+2)=X
+34 QUIT
End DoDot:1
+35 IF NMERR=1
DO NAMERR
+36 if PATSERR=1
QUIT
+37 IF 'QACI0
IF USERTYPE="E"
SET $PIECE(EMPDATA,"^",9)=TITLE
SET $PIECE(EMPDATA,"^",10)=MAILCODE
+38 SET ^XTMP("QACMIGR",UTYPE,"U",IEN)=EMPDATA
+39 SET PATSCNT(UTYPE)=PATSCNT(UTYPE)+1
+40 QUIT
+41 ;
CONVDATE(OLDDATE) ; Convert data to MM/DD/YYYY format
+1 NEW MM,DD
SET MM=$EXTRACT(OLDDATE,4,5)
SET DD=$EXTRACT(OLDDATE,6,7)
+2 if MM="00"
SET MM="01"
+3 if DD="00"
SET DD="01"
+4 SET OLDDATE=$EXTRACT(OLDDATE,1,3)_MM_DD
+5 QUIT $$FMTE^XLFDT(OLDDATE,5)
+6 ;
NAMERR ;
+1 NEW X
SET X="Name invalid"
+2 IF $GET(DSPNAME)]""
SET X=DSPNAME_" - "_X
+3 SET PATSERR=1
DO ERREF^QACI2C(UTYPE,IEN,X)
+4 QUIT
+5 ;
