- 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**;AUG 13, 1993;Build 4
- ;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDRPA08 7041 printed Feb 19, 2025@00:26:48 Page 2
- 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**;AUG 13, 1993;Build 4
- +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