SDRPA08 ;BP-OIFO/OWAIN,ESW - Patient Appointment Data Compilation ; 9/10/04 9:41am ; Compiled April 24, 2006 16:55:01 ; Compiled July 1, 2008 16:48:16
;;5.3;Scheduling;**290,333,349,376,528,1015**;AUG 13, 1993;Build 21
;This program generates appointment data into ^TMP("SDDPT",$J to be used by HL7 builder
Q
;
APPT(DFN,SDADT,SDDM,SDCL,SDSTAT) ;
;SDDM - HL7 format of creation date
;SDSTAT - string from SDRPA05
N ARRAY,SDCLNM,SDSTOP,SDSTOP1,SDCSTOP,SDCSTOP1,SDINST,SDFAC,SDSDDT,SDCDT,SDARF,SDARDT,SDENRO,SDNAVA,SD6A,SD8A,SD8RD
N SDNEW,SDSCHED,SDCHKOUT,SDPRVSEQ,SDCNT,SDSCE,SDSTOPD,SDCSTOPD
D GETS^DIQ(44,SDCL_",",".01;3;8;99;2503","I","ARRAY") ; GETS called to try to improve efficiency.
S SDCLNM=$G(ARRAY(44,SDCL_",",.01,"I")) ; Clinic name.
S SDSTOP1=$G(ARRAY(44,SDCL_",",8,"I")) ; DSS identifier of clinic.
S SDSTOP=$$GET1^DIQ(40.7,SDSTOP1_",",1,"I")
S SDSTOPD=$$GET1^DIQ(40.7,SDSTOP1_",",.01,"I") ;description
S SDCSTOP1=$G(ARRAY(44,SDCL_",",2503,"I")) ; DSS credit stop of clinic.
S SDCSTOP="",SDCSTOPD=""
I SDCSTOP1>0 S SDCSTOP=$$GET1^DIQ(40.7,SDCSTOP1_",",1,"I"),SDCSTOPD=$$GET1^DIQ(40.7,SDCSTOP1_",",.01,"I")
;retrieve institution and station number through the division path
S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
S SDFAC=""
I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") D
.S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
I SDFAC="" D
.I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
.S SDFAC=$P($$SITE^VASITE(,),"^",3)
;
S SDCHKOUT=""
I $P(SDSTAT,"^",5)'="" S SDCHKOUT=$$DTCONV($P(SDSTAT,"^",5))
S SD8RD=""
I $P(SDSTAT,"^",7)'="" S SD8RD=$$DTCONV($P(SDSTAT,"^",7))
S SDSDDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",27,"I")) ; desired date
S SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I") ; Cancellation date.
S SDARF=$S($$GET1^DIQ(2.98,SDADT_","_DFN_",",25,"I")="A":"A",1:"") ; Auto-rebook flag.
S SDARDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",12,"I")) ; Auto-rebook date.
S SDNAVA=$$GET1^DIQ(2.98,SDADT_","_DFN_",",26,"I") ; Next available appointment indicator.
I SDNAVA=0 D
.I SDARF="A" S SDNAVA=4
.E S SDNAVA=5
I SDNAVA="" S SDNAVA=6
S SDNEW=$$NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC) ; New to facility/clinic flag.
;
S SD6A=$P(SDSTAT,"^",3) S SD8A=$P(SDSTAT,"^",4)
S ^TMP("SDDPT",$J,DFN,SDADT)=$$DTCONV(SDADT)_"^"_SDDM_"^"_SDSDDT_"^^"_SDNAVA_"^"_SDCHKOUT_"^"_$$DTCONV(SDCDT)_"^^"_SDARDT
S ^TMP("SDDPT",$J,DFN,SDADT)=^TMP("SDDPT",$J,DFN,SDADT)_"^"_SDNEW_"^^"_SDCL_"^"_SDCLNM_"^"_SDSTOP_"^"_SDCSTOP_"^"_SDFAC
S ^TMP("SDDPT",$J,DFN,SDADT,"SCH")=$P(SDSTAT,U,1,6)_U_SD8RD ;446 added consult request date in SDRPA07
S ^TMP("SDDPT",$J,DFN,SDADT,"STDC")=SDSTOPD_"^"_SDCSTOPD
; Outpatient classification.
S SDSCE=$$GET1^DIQ(2.98,SDADT_","_DFN_",",21,"I")
I SDSCE'="" D EN^VAFHLZCL(DFN,SDSCE,"1,2,3","","^","^TMP(""SDDPT"",$J,DFN,SDADT,""ZCL"")")
;get patient class
D GETAPPT^SDAMA201(DFN,"12",,SDADT,SDADT) N SDPATCL D K ^TMP($J,"SDAMA201")
.S SDPATCL=$G(^TMP($J,"SDAMA201","GETAPPT",1,12))
.I SDPATCL="" D
..I SDSCE'="" N SDVST S SDVST=$$GET1^DIQ(409.68,SDSCE_",",.05,"I") D
...I SDVST S SDPATCL=$$GET1^DIQ(9000010,SDVST_",",15002,"I")
...S SDPATCL=$S(SDPATCL=1:"I",SDPATCL=0:"O",1:"U")
..I SDSCE="" S SDPATCL="U"
.S $P(^TMP("SDDPT",$J,DFN,SDADT),"^",4)=SDPATCL
; Get providers for clinic.
N SDPROV S (SDPRVSEQ,SDCNT)=0,SDPROV=""
N PROVID
F S SDPRVSEQ=$O(^SC(SDCL,"PR",SDPRVSEQ)) Q:+SDPRVSEQ'=SDPRVSEQ!(SDCNT>10) D
.S SDCNT=SDCNT+1,PROVID=$$GET1^DIQ(44.1,SDPRVSEQ_","_SDCL_",",.01,"I")
.S ^TMP("SDDPT",$J,DFN,SDADT,"ROL",SDCNT)="ROL^"_SDCNT_"^"_PROVID_"^"_$$GET1^DIQ(200,PROVID_",",.01,"I")
.Q
Q
NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC) ; New to facility/clinic flag.
N OK,SDADT0,SDFAC1,SDDIV
S OK=0,SDADT0=SDADT
F S SDADT=$O(^DPT(DFN,"S",SDADT),-1) Q:'SDADT Q:$$GT24(SDADT,SDADT0) D Q:OK
.N SDCL,SDDIV,ARRAY
.S SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
.Q:$$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
.Q:$$GET1^DIQ(44,SDCL_",",2503,"I")'=SDCSTOP1
.S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
.S SDFAC1=""
.I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") D
..S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
.I SDFAC1="" D
..I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
..S SDFAC1=$P($$SITE^VASITE(,),"^",3)
.I SDFAC1=SDFAC S OK=3
.Q
I OK Q OK
S SDADT=SDADT0
F S SDADT=$O(^DPT(DFN,"S",SDADT),-1) Q:'SDADT Q:$$GT24(SDADT,SDADT0) D Q:OK
.N SDCL,SDDIV,ARRAY
.S SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
.Q:$$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
.S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
.S SDFAC1=""
.I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") D
..S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
.I SDFAC1="" D
..I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
..S SDFAC1=$P($$SITE^VASITE(,),"^",3)
.I $E(SDFAC1,1,3)=$E(SDFAC,1,3) S OK=2
.Q
I OK Q OK
S OK=1 Q OK
;
GT24(DATE1,DATE2) ; Are two dates greater than 24 months apart?
; DATE1 should be before DATE2.
; If they are not in that order, they are swapped anyway.
N MONTHS,TEMP
I DATE1>DATE2 S TEMP=DATE1,DATE1=DATE2,DATE2=TEMP
S MONTHS=$E(DATE2,2,3)-$E(DATE1,2,3)*12+$E(DATE2,4,5)-$E(DATE1,4,5)
Q MONTHS>24
DPT(DFN,SDCE) ;
; Extrinsic. Returns boolean, 0: ^TMP("SDDPT",$J,DFN) not created; 1: created.
;
N SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME,DOB,SSN,SSNP,SDSC,ICN,SDADT,SDSCP,ARRAY,SDDCE
S SDDCE=$$GET1^DIQ(2,DFN_",",27.01,"I") ; Current enrollment. Required elsewhere.
S:SDDCE="" SDCE="" I SDDCE>0 S SDCE=$$GET1^DIQ(27.11,SDDCE_",",.07,"I") ; Enrollment priority
Q:$D(^TMP("SDDPT",$J,DFN)) 1
D GETS^DIQ(2,DFN_",",".301;.302;991.01","I","ARRAY") ; GETS called to try to improve efficiency.
S SDSC=$G(ARRAY(2,DFN_",",.301,"I")) ; Service connected.
S SDSCP=$G(ARRAY(2,DFN_",",.302,"I")) ; Service connected percentage.
S ICN=$$GETICN^MPIF001(DFN) ; Integration Control Number.
I +ICN<0 S ICN="" ;
D DEM^VADPT ;VADM array as output of this call
S (SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME(1))=""
S NAME=$$GETNAME(DFN)
S DOB=$$DTCONV($P($G(VADM(3)),"^")) ; Date of birth.
S (SSN,SSNP)="" S SSN=$P($G(VADM(2)),"^") I SSN["P" S SSNP="P",SSN=$E(SSN,1,9) ; Social security number.
Q:$E(SSN,1,5)="00000" 0 ; Exclude test patients.
;
S ^TMP("SDDPT",$J,DFN)=ICN_"^"_SSN_SSNP_"^"_NAME_"^"_DOB_"^"_$E(SDSC)_"^"_SDSCP_"^"_SDCE
Q 1
DTCONV(DT) ; Date conversion.
; CYYMMDD -> CCYYMMDD
; CYYMMDD.H{HMMSS} -> CCYYMMDDHHMM
I DT?7N Q DT+17E6
Q:DT?7N1"."1.6N DT\1+17E6_$E(DT#1+1*1E4,2,5)
Q ""
GETNAME(NMID) ; Name in HL7 format.
N SDNAME,NAME,SDNAMEL,SDNAMF,SDNAMEM,SDNAMES,SDNAMEF
S SDNAME("FILE")=2,SDNAME("IENS")=NMID,SDNAME("FIELD")=.01
S NAME(1)=$$HLNAME^XLFNAME(.SDNAME,"","^")
S SDNAMEL=$P($G(NAME(1)),"^"),SDNAMEF=$P($G(NAME(1)),"^",2),SDNAMEM=$P($G(NAME(1)),"^",3),SDNAMES=$P($G(NAME(1)),"^",4)
Q SDNAMEL_"^"_SDNAMEF_"^"_SDNAMEM_" "_SDNAMES
Q
SDRPA08 ;BP-OIFO/OWAIN,ESW - Patient Appointment Data Compilation ; 9/10/04 9:41am ; Compiled April 24, 2006 16:55:01 ; Compiled July 1, 2008 16:48:16
+1 ;;5.3;Scheduling;**290,333,349,376,528,1015**;AUG 13, 1993;Build 21
+2 ;This program generates appointment data into ^TMP("SDDPT",$J to be used by HL7 builder
+3 QUIT
+4 ;
APPT(DFN,SDADT,SDDM,SDCL,SDSTAT) ;
+1 ;SDDM - HL7 format of creation date
+2 ;SDSTAT - string from SDRPA05
+3 NEW ARRAY,SDCLNM,SDSTOP,SDSTOP1,SDCSTOP,SDCSTOP1,SDINST,SDFAC,SDSDDT,SDCDT,SDARF,SDARDT,SDENRO,SDNAVA,SD6A,SD8A,SD8RD
+4 NEW SDNEW,SDSCHED,SDCHKOUT,SDPRVSEQ,SDCNT,SDSCE,SDSTOPD,SDCSTOPD
+5 ; GETS called to try to improve efficiency.
DO GETS^DIQ(44,SDCL_",",".01;3;8;99;2503","I","ARRAY")
+6 ; Clinic name.
SET SDCLNM=$GET(ARRAY(44,SDCL_",",.01,"I"))
+7 ; DSS identifier of clinic.
SET SDSTOP1=$GET(ARRAY(44,SDCL_",",8,"I"))
+8 SET SDSTOP=$$GET1^DIQ(40.7,SDSTOP1_",",1,"I")
+9 ;description
SET SDSTOPD=$$GET1^DIQ(40.7,SDSTOP1_",",.01,"I")
+10 ; DSS credit stop of clinic.
SET SDCSTOP1=$GET(ARRAY(44,SDCL_",",2503,"I"))
+11 SET SDCSTOP=""
SET SDCSTOPD=""
+12 IF SDCSTOP1>0
SET SDCSTOP=$$GET1^DIQ(40.7,SDCSTOP1_",",1,"I")
SET SDCSTOPD=$$GET1^DIQ(40.7,SDCSTOP1_",",.01,"I")
+13 ;retrieve institution and station number through the division path
+14 SET SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
+15 SET SDFAC=""
+16 IF SDDIV'=""
SET SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
Begin DoDot:1
+17 ; Station
SET SDFAC=$SELECT(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I"))
End DoDot:1
+18 IF SDFAC=""
Begin DoDot:1
+19 IF SDDIV'=""
SET SDFAC1=$PIECE($$SITE^VASITE(,SDDIV),"^",3)
QUIT
+20 SET SDFAC=$PIECE($$SITE^VASITE(,),"^",3)
End DoDot:1
+21 ;
+22 SET SDCHKOUT=""
+23 IF $PIECE(SDSTAT,"^",5)'=""
SET SDCHKOUT=$$DTCONV($PIECE(SDSTAT,"^",5))
+24 SET SD8RD=""
+25 IF $PIECE(SDSTAT,"^",7)'=""
SET SD8RD=$$DTCONV($PIECE(SDSTAT,"^",7))
+26 ; desired date
SET SDSDDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",27,"I"))
+27 ; Cancellation date.
SET SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I")
+28 ; Auto-rebook flag.
SET SDARF=$SELECT($$GET1^DIQ(2.98,SDADT_","_DFN_",",25,"I")="A":"A",1:"")
+29 ; Auto-rebook date.
SET SDARDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",12,"I"))
+30 ; Next available appointment indicator.
SET SDNAVA=$$GET1^DIQ(2.98,SDADT_","_DFN_",",26,"I")
+31 IF SDNAVA=0
Begin DoDot:1
+32 IF SDARF="A"
SET SDNAVA=4
+33 IF '$TEST
SET SDNAVA=5
End DoDot:1
+34 IF SDNAVA=""
SET SDNAVA=6
+35 ; New to facility/clinic flag.
SET SDNEW=$$NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC)
+36 ;
+37 SET SD6A=$PIECE(SDSTAT,"^",3)
SET SD8A=$PIECE(SDSTAT,"^",4)
+38 SET ^TMP("SDDPT",$JOB,DFN,SDADT)=$$DTCONV(SDADT)_"^"_SDDM_"^"_SDSDDT_"^^"_SDNAVA_"^"_SDCHKOUT_"^"_$$DTCONV(SDCDT)_"^^"_SDARDT
+39 SET ^TMP("SDDPT",$JOB,DFN,SDADT)=^TMP("SDDPT",$JOB,DFN,SDADT)_"^"_SDNEW_"^^"_SDCL_"^"_SDCLNM_"^"_SDSTOP_"^"_SDCSTOP_"^"_SDFAC
+40 ;446 added consult request date in SDRPA07
SET ^TMP("SDDPT",$JOB,DFN,SDADT,"SCH")=$PIECE(SDSTAT,U,1,6)_U_SD8RD
+41 SET ^TMP("SDDPT",$JOB,DFN,SDADT,"STDC")=SDSTOPD_"^"_SDCSTOPD
+42 ; Outpatient classification.
+43 SET SDSCE=$$GET1^DIQ(2.98,SDADT_","_DFN_",",21,"I")
+44 IF SDSCE'=""
DO EN^VAFHLZCL(DFN,SDSCE,"1,2,3","","^","^TMP(""SDDPT"",$J,DFN,SDADT,""ZCL"")")
+45 ;get patient class
+46 DO GETAPPT^SDAMA201(DFN,"12",,SDADT,SDADT)
NEW SDPATCL
Begin DoDot:1
+47 SET SDPATCL=$GET(^TMP($JOB,"SDAMA201","GETAPPT",1,12))
+48 IF SDPATCL=""
Begin DoDot:2
+49 IF SDSCE'=""
NEW SDVST
SET SDVST=$$GET1^DIQ(409.68,SDSCE_",",.05,"I")
Begin DoDot:3
+50 IF SDVST
SET SDPATCL=$$GET1^DIQ(9000010,SDVST_",",15002,"I")
+51 SET SDPATCL=$SELECT(SDPATCL=1:"I",SDPATCL=0:"O",1:"U")
End DoDot:3
+52 IF SDSCE=""
SET SDPATCL="U"
End DoDot:2
+53 SET $PIECE(^TMP("SDDPT",$JOB,DFN,SDADT),"^",4)=SDPATCL
End DoDot:1
KILL ^TMP($JOB,"SDAMA201")
+54 ; Get providers for clinic.
+55 NEW SDPROV
SET (SDPRVSEQ,SDCNT)=0
SET SDPROV=""
+56 NEW PROVID
+57 FOR
SET SDPRVSEQ=$ORDER(^SC(SDCL,"PR",SDPRVSEQ))
IF +SDPRVSEQ'=SDPRVSEQ!(SDCNT>10)
QUIT
Begin DoDot:1
+58 SET SDCNT=SDCNT+1
SET PROVID=$$GET1^DIQ(44.1,SDPRVSEQ_","_SDCL_",",.01,"I")
+59 SET ^TMP("SDDPT",$JOB,DFN,SDADT,"ROL",SDCNT)="ROL^"_SDCNT_"^"_PROVID_"^"_$$GET1^DIQ(200,PROVID_",",.01,"I")
+60 QUIT
End DoDot:1
+61 QUIT
NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC) ; New to facility/clinic flag.
+1 NEW OK,SDADT0,SDFAC1,SDDIV
+2 SET OK=0
SET SDADT0=SDADT
+3 FOR
SET SDADT=$ORDER(^DPT(DFN,"S",SDADT),-1)
IF 'SDADT
QUIT
IF $$GT24(SDADT,SDADT0)
QUIT
Begin DoDot:1
+4 NEW SDCL,SDDIV,ARRAY
+5 SET SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
+6 IF $$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
QUIT
+7 IF $$GET1^DIQ(44,SDCL_",",2503,"I")'=SDCSTOP1
QUIT
+8 SET SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
+9 SET SDFAC1=""
+10 IF SDDIV'=""
SET SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
Begin DoDot:2
+11 ; Station
SET SDFAC1=$SELECT(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I"))
End DoDot:2
+12 IF SDFAC1=""
Begin DoDot:2
+13 IF SDDIV'=""
SET SDFAC1=$PIECE($$SITE^VASITE(,SDDIV),"^",3)
QUIT
+14 SET SDFAC1=$PIECE($$SITE^VASITE(,),"^",3)
End DoDot:2
+15 IF SDFAC1=SDFAC
SET OK=3
+16 QUIT
End DoDot:1
IF OK
QUIT
+17 IF OK
QUIT OK
+18 SET SDADT=SDADT0
+19 FOR
SET SDADT=$ORDER(^DPT(DFN,"S",SDADT),-1)
IF 'SDADT
QUIT
IF $$GT24(SDADT,SDADT0)
QUIT
Begin DoDot:1
+20 NEW SDCL,SDDIV,ARRAY
+21 SET SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
+22 IF $$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
QUIT
+23 SET SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
+24 SET SDFAC1=""
+25 IF SDDIV'=""
SET SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
Begin DoDot:2
+26 ; Station
SET SDFAC1=$SELECT(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I"))
End DoDot:2
+27 IF SDFAC1=""
Begin DoDot:2
+28 IF SDDIV'=""
SET SDFAC1=$PIECE($$SITE^VASITE(,SDDIV),"^",3)
QUIT
+29 SET SDFAC1=$PIECE($$SITE^VASITE(,),"^",3)
End DoDot:2
+30 IF $EXTRACT(SDFAC1,1,3)=$EXTRACT(SDFAC,1,3)
SET OK=2
+31 QUIT
End DoDot:1
IF OK
QUIT
+32 IF OK
QUIT OK
+33 SET OK=1
QUIT OK
+34 ;
GT24(DATE1,DATE2) ; Are two dates greater than 24 months apart?
+1 ; DATE1 should be before DATE2.
+2 ; If they are not in that order, they are swapped anyway.
+3 NEW MONTHS,TEMP
+4 IF DATE1>DATE2
SET TEMP=DATE1
SET DATE1=DATE2
SET DATE2=TEMP
+5 SET MONTHS=$EXTRACT(DATE2,2,3)-$EXTRACT(DATE1,2,3)*12+$EXTRACT(DATE2,4,5)-$EXTRACT(DATE1,4,5)
+6 QUIT MONTHS>24
DPT(DFN,SDCE) ;
+1 ; Extrinsic. Returns boolean, 0: ^TMP("SDDPT",$J,DFN) not created; 1: created.
+2 ;
+3 NEW SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME,DOB,SSN,SSNP,SDSC,ICN,SDADT,SDSCP,ARRAY,SDDCE
+4 ; Current enrollment. Required elsewhere.
SET SDDCE=$$GET1^DIQ(2,DFN_",",27.01,"I")
+5 ; Enrollment priority
IF SDDCE=""
SET SDCE=""
IF SDDCE>0
SET SDCE=$$GET1^DIQ(27.11,SDDCE_",",.07,"I")
+6 IF $DATA(^TMP("SDDPT",$JOB,DFN))
QUIT 1
+7 ; GETS called to try to improve efficiency.
DO GETS^DIQ(2,DFN_",",".301;.302;991.01","I","ARRAY")
+8 ; Service connected.
SET SDSC=$GET(ARRAY(2,DFN_",",.301,"I"))
+9 ; Service connected percentage.
SET SDSCP=$GET(ARRAY(2,DFN_",",.302,"I"))
+10 ; Integration Control Number.
SET ICN=$$GETICN^MPIF001(DFN)
+11 ;
IF +ICN<0
SET ICN=""
+12 ;VADM array as output of this call
DO DEM^VADPT
+13 SET (SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME(1))=""
+14 SET NAME=$$GETNAME(DFN)
+15 ; Date of birth.
SET DOB=$$DTCONV($PIECE($GET(VADM(3)),"^"))
+16 ; Social security number.
SET (SSN,SSNP)=""
SET SSN=$PIECE($GET(VADM(2)),"^")
IF SSN["P"
SET SSNP="P"
SET SSN=$EXTRACT(SSN,1,9)
+17 ; Exclude test patients.
IF $EXTRACT(SSN,1,5)="00000"
QUIT 0
+18 ;
+19 SET ^TMP("SDDPT",$JOB,DFN)=ICN_"^"_SSN_SSNP_"^"_NAME_"^"_DOB_"^"_$EXTRACT(SDSC)_"^"_SDSCP_"^"_SDCE
+20 QUIT 1
DTCONV(DT) ; Date conversion.
+1 ; CYYMMDD -> CCYYMMDD
+2 ; CYYMMDD.H{HMMSS} -> CCYYMMDDHHMM
+3 IF DT?7N
QUIT DT+17E6
+4 IF DT?7N1"."1.6N
QUIT DT\1+17E6_$EXTRACT(DT#1+1*1E4,2,5)
+5 QUIT ""
GETNAME(NMID) ; Name in HL7 format.
+1 NEW SDNAME,NAME,SDNAMEL,SDNAMF,SDNAMEM,SDNAMES,SDNAMEF
+2 SET SDNAME("FILE")=2
SET SDNAME("IENS")=NMID
SET SDNAME("FIELD")=.01
+3 SET NAME(1)=$$HLNAME^XLFNAME(.SDNAME,"","^")
+4 SET SDNAMEL=$PIECE($GET(NAME(1)),"^")
SET SDNAMEF=$PIECE($GET(NAME(1)),"^",2)
SET SDNAMEM=$PIECE($GET(NAME(1)),"^",3)
SET SDNAMES=$PIECE($GET(NAME(1)),"^",4)
+5 QUIT SDNAMEL_"^"_SDNAMEF_"^"_SDNAMEM_" "_SDNAMES
+6 QUIT
