Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDRPA08

SDRPA08.m

Go to the documentation of this file.
  1. 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
  1. ;This program generates appointment data into ^TMP("SDDPT",$J to be used by HL7 builder
  1. Q
  1. ;
  1. APPT(DFN,SDADT,SDDM,SDCL,SDSTAT) ;
  1. ;SDDM - HL7 format of creation date
  1. ;SDSTAT - string from SDRPA05
  1. N ARRAY,SDCLNM,SDSTOP,SDSTOP1,SDCSTOP,SDCSTOP1,SDINST,SDFAC,SDSDDT,SDCDT,SDARF,SDARDT,SDENRO,SDNAVA,SD6A,SD8A,SD8RD
  1. N SDNEW,SDSCHED,SDCHKOUT,SDPRVSEQ,SDCNT,SDSCE,SDSTOPD,SDCSTOPD
  1. D GETS^DIQ(44,SDCL_",",".01;3;8;99;2503","I","ARRAY") ; GETS called to try to improve efficiency.
  1. S SDCLNM=$G(ARRAY(44,SDCL_",",.01,"I")) ; Clinic name.
  1. S SDSTOP1=$G(ARRAY(44,SDCL_",",8,"I")) ; DSS identifier of clinic.
  1. S SDSTOP=$$GET1^DIQ(40.7,SDSTOP1_",",1,"I")
  1. S SDSTOPD=$$GET1^DIQ(40.7,SDSTOP1_",",.01,"I") ;description
  1. S SDCSTOP1=$G(ARRAY(44,SDCL_",",2503,"I")) ; DSS credit stop of clinic.
  1. S SDCSTOP="",SDCSTOPD=""
  1. I SDCSTOP1>0 S SDCSTOP=$$GET1^DIQ(40.7,SDCSTOP1_",",1,"I"),SDCSTOPD=$$GET1^DIQ(40.7,SDCSTOP1_",",.01,"I")
  1. ;retrieve institution and station number through the division path
  1. S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
  1. S SDFAC=""
  1. I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") D
  1. .S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
  1. I SDFAC="" D
  1. .I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
  1. .S SDFAC=$P($$SITE^VASITE(,),"^",3)
  1. ;
  1. S SDCHKOUT=""
  1. I $P(SDSTAT,"^",5)'="" S SDCHKOUT=$$DTCONV($P(SDSTAT,"^",5))
  1. S SD8RD=""
  1. I $P(SDSTAT,"^",7)'="" S SD8RD=$$DTCONV($P(SDSTAT,"^",7))
  1. S SDSDDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",27,"I")) ; desired date
  1. S SDCDT=$$GET1^DIQ(2.98,SDADT_","_DFN_",",15,"I") ; Cancellation date.
  1. S SDARF=$S($$GET1^DIQ(2.98,SDADT_","_DFN_",",25,"I")="A":"A",1:"") ; Auto-rebook flag.
  1. S SDARDT=$$DTCONV($$GET1^DIQ(2.98,SDADT_","_DFN_",",12,"I")) ; Auto-rebook date.
  1. S SDNAVA=$$GET1^DIQ(2.98,SDADT_","_DFN_",",26,"I") ; Next available appointment indicator.
  1. I SDNAVA=0 D
  1. .I SDARF="A" S SDNAVA=4
  1. .E S SDNAVA=5
  1. I SDNAVA="" S SDNAVA=6
  1. S SDNEW=$$NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC) ; New to facility/clinic flag.
  1. ;
  1. S SD6A=$P(SDSTAT,"^",3) S SD8A=$P(SDSTAT,"^",4)
  1. S ^TMP("SDDPT",$J,DFN,SDADT)=$$DTCONV(SDADT)_"^"_SDDM_"^"_SDSDDT_"^^"_SDNAVA_"^"_SDCHKOUT_"^"_$$DTCONV(SDCDT)_"^^"_SDARDT
  1. S ^TMP("SDDPT",$J,DFN,SDADT)=^TMP("SDDPT",$J,DFN,SDADT)_"^"_SDNEW_"^^"_SDCL_"^"_SDCLNM_"^"_SDSTOP_"^"_SDCSTOP_"^"_SDFAC
  1. S ^TMP("SDDPT",$J,DFN,SDADT,"SCH")=$P(SDSTAT,U,1,6)_U_SD8RD ;446 added consult request date in SDRPA07
  1. S ^TMP("SDDPT",$J,DFN,SDADT,"STDC")=SDSTOPD_"^"_SDCSTOPD
  1. ; Outpatient classification.
  1. S SDSCE=$$GET1^DIQ(2.98,SDADT_","_DFN_",",21,"I")
  1. I SDSCE'="" D EN^VAFHLZCL(DFN,SDSCE,"1,2,3","","^","^TMP(""SDDPT"",$J,DFN,SDADT,""ZCL"")")
  1. ;get patient class
  1. D GETAPPT^SDAMA201(DFN,"12",,SDADT,SDADT) N SDPATCL D K ^TMP($J,"SDAMA201")
  1. .S SDPATCL=$G(^TMP($J,"SDAMA201","GETAPPT",1,12))
  1. .I SDPATCL="" D
  1. ..I SDSCE'="" N SDVST S SDVST=$$GET1^DIQ(409.68,SDSCE_",",.05,"I") D
  1. ...I SDVST S SDPATCL=$$GET1^DIQ(9000010,SDVST_",",15002,"I")
  1. ...S SDPATCL=$S(SDPATCL=1:"I",SDPATCL=0:"O",1:"U")
  1. ..I SDSCE="" S SDPATCL="U"
  1. .S $P(^TMP("SDDPT",$J,DFN,SDADT),"^",4)=SDPATCL
  1. ; Get providers for clinic.
  1. N SDPROV S (SDPRVSEQ,SDCNT)=0,SDPROV=""
  1. N PROVID
  1. F S SDPRVSEQ=$O(^SC(SDCL,"PR",SDPRVSEQ)) Q:+SDPRVSEQ'=SDPRVSEQ!(SDCNT>10) D
  1. .S SDCNT=SDCNT+1,PROVID=$$GET1^DIQ(44.1,SDPRVSEQ_","_SDCL_",",.01,"I")
  1. .S ^TMP("SDDPT",$J,DFN,SDADT,"ROL",SDCNT)="ROL^"_SDCNT_"^"_PROVID_"^"_$$GET1^DIQ(200,PROVID_",",.01,"I")
  1. .Q
  1. Q
  1. NEWAT(DFN,SDADT,SDSTOP1,SDCSTOP1,SDFAC) ; New to facility/clinic flag.
  1. N OK,SDADT0,SDFAC1,SDDIV
  1. S OK=0,SDADT0=SDADT
  1. F S SDADT=$O(^DPT(DFN,"S",SDADT),-1) Q:'SDADT Q:$$GT24(SDADT,SDADT0) D Q:OK
  1. .N SDCL,SDDIV,ARRAY
  1. .S SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
  1. .Q:$$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
  1. .Q:$$GET1^DIQ(44,SDCL_",",2503,"I")'=SDCSTOP1
  1. .S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
  1. .S SDFAC1=""
  1. .I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") D
  1. ..S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
  1. .I SDFAC1="" D
  1. ..I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
  1. ..S SDFAC1=$P($$SITE^VASITE(,),"^",3)
  1. .I SDFAC1=SDFAC S OK=3
  1. .Q
  1. I OK Q OK
  1. S SDADT=SDADT0
  1. F S SDADT=$O(^DPT(DFN,"S",SDADT),-1) Q:'SDADT Q:$$GT24(SDADT,SDADT0) D Q:OK
  1. .N SDCL,SDDIV,ARRAY
  1. .S SDCL=$$GET1^DIQ(2.98,SDADT_","_DFN_",",.01,"I")
  1. .Q:$$GET1^DIQ(44,SDCL_",",8,"I")'=SDSTOP1
  1. .S SDDIV=$$GET1^DIQ(44,SDCL_",",3.5,"I")
  1. .S SDFAC1=""
  1. .I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") D
  1. ..S SDFAC1=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
  1. .I SDFAC1="" D
  1. ..I SDDIV'="" S SDFAC1=$P($$SITE^VASITE(,SDDIV),"^",3) Q
  1. ..S SDFAC1=$P($$SITE^VASITE(,),"^",3)
  1. .I $E(SDFAC1,1,3)=$E(SDFAC,1,3) S OK=2
  1. .Q
  1. I OK Q OK
  1. S OK=1 Q OK
  1. ;
  1. GT24(DATE1,DATE2) ; Are two dates greater than 24 months apart?
  1. ; DATE1 should be before DATE2.
  1. ; If they are not in that order, they are swapped anyway.
  1. N MONTHS,TEMP
  1. I DATE1>DATE2 S TEMP=DATE1,DATE1=DATE2,DATE2=TEMP
  1. S MONTHS=$E(DATE2,2,3)-$E(DATE1,2,3)*12+$E(DATE2,4,5)-$E(DATE1,4,5)
  1. Q MONTHS>24
  1. DPT(DFN,SDCE) ;
  1. ; Extrinsic. Returns boolean, 0: ^TMP("SDDPT",$J,DFN) not created; 1: created.
  1. ;
  1. N SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME,DOB,SSN,SSNP,SDSC,ICN,SDADT,SDSCP,ARRAY,SDDCE
  1. S SDDCE=$$GET1^DIQ(2,DFN_",",27.01,"I") ; Current enrollment. Required elsewhere.
  1. S:SDDCE="" SDCE="" I SDDCE>0 S SDCE=$$GET1^DIQ(27.11,SDDCE_",",.07,"I") ; Enrollment priority
  1. Q:$D(^TMP("SDDPT",$J,DFN)) 1
  1. D GETS^DIQ(2,DFN_",",".301;.302;991.01","I","ARRAY") ; GETS called to try to improve efficiency.
  1. S SDSC=$G(ARRAY(2,DFN_",",.301,"I")) ; Service connected.
  1. S SDSCP=$G(ARRAY(2,DFN_",",.302,"I")) ; Service connected percentage.
  1. S ICN=$$GETICN^MPIF001(DFN) ; Integration Control Number.
  1. I +ICN<0 S ICN="" ;
  1. D DEM^VADPT ;VADM array as output of this call
  1. S (SDNAMEL,SDNAMEF,SDNAMEM,SDNAMES,SDNAME,NAME(1))=""
  1. S NAME=$$GETNAME(DFN)
  1. S DOB=$$DTCONV($P($G(VADM(3)),"^")) ; Date of birth.
  1. S (SSN,SSNP)="" S SSN=$P($G(VADM(2)),"^") I SSN["P" S SSNP="P",SSN=$E(SSN,1,9) ; Social security number.
  1. Q:$E(SSN,1,5)="00000" 0 ; Exclude test patients.
  1. ;
  1. S ^TMP("SDDPT",$J,DFN)=ICN_"^"_SSN_SSNP_"^"_NAME_"^"_DOB_"^"_$E(SDSC)_"^"_SDSCP_"^"_SDCE
  1. Q 1
  1. DTCONV(DT) ; Date conversion.
  1. ; CYYMMDD -> CCYYMMDD
  1. ; CYYMMDD.H{HMMSS} -> CCYYMMDDHHMM
  1. I DT?7N Q DT+17E6
  1. Q:DT?7N1"."1.6N DT\1+17E6_$E(DT#1+1*1E4,2,5)
  1. Q ""
  1. GETNAME(NMID) ; Name in HL7 format.
  1. N SDNAME,NAME,SDNAMEL,SDNAMF,SDNAMEM,SDNAMES,SDNAMEF
  1. S SDNAME("FILE")=2,SDNAME("IENS")=NMID,SDNAME("FIELD")=.01
  1. S NAME(1)=$$HLNAME^XLFNAME(.SDNAME,"","^")
  1. S SDNAMEL=$P($G(NAME(1)),"^"),SDNAMEF=$P($G(NAME(1)),"^",2),SDNAMEM=$P($G(NAME(1)),"^",3),SDNAMES=$P($G(NAME(1)),"^",4)
  1. Q SDNAMEL_"^"_SDNAMEF_"^"_SDNAMEM_" "_SDNAMES
  1. Q