C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-05-03 6:09 PM ;;1.1;FILEMAN TRIPLE STORE;; ; (C) Sam Habiel 2013 ; Proprietary code. Stay out! ; ; Get all graphs NEW RETURN DO GRAPHS^C0XGET1(.RETURN) ; TODO: Return could be a global due to large data. N C0XI S C0XI="" F S C0XI=$O(RETURN(C0XI)) Q:C0XI="" D ; For each IEN . N G S G="" F S G=$O(RETURN(C0XI,G)) Q:G="" D ; For each graph tied to IEN . . D PROGRAPH(G) ; Process Graph QUIT ; PROGRAPH(G) ; Process Graph (i.e. Patient) NEW RETURN N DEM S DEM=$$ONETYPE1^C0XGET3(G,"sp:Demographics") I DEM="" QUIT ; ; PARAM("NAME")=NAME (last name minimal; recommend full name) ; PARAM("GENDER")=SEX ; PARAM("DOB")=DATE OF BIRTH ; PARAM("MRN")=MEDICAL RECORD NUMBER ; NEW PARAM SET PARAM("NAME")=$$NAME(DEM) SET PARAM("GENDER")=$$SEX(DEM) SET PARAM("DOB")=$$DOB(DEM) SET PARAM("MRN")=$$MRN(DEM) NEW RETURN WRITE !!,PARAM("NAME"),! D ADDPT(.RETURN,.PARAM) N DFN S DFN=$P(RETURN(1),U,2) I DFN<1 S $EC=",U1," ; Debug.Assert that patient is added. ; D VITALS(G,DFN) D PROBLEMS^C0XPT1(G,DFN) ; Extract Problems and File D ADR^C0XPT2(G,DFN) ; Extract Allergies and File D MEDS^C0XPT3(G,DFN) ; Extract Medicaments and File D ENC^C0XPT4(G,DFN) ; Extract Encounters and File ; QUIT ; NAME(DEMID) ; Public $$; Return VISTA name given the Demographics node ID. ; IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in. ; ; Get name node NEW NAMENODE SET NAMENODE=$$object^C0XGET1(DEMID,"v:n") IF '$L(NAMENODE) SET $EC=",U1," ; Not supposed to happen. ; ; Get Last name NEW FAMILY SET FAMILY=$$object^C0XGET1(NAMENODE,"v:family-name") IF '$L(FAMILY) SET $EC=",U1," ; Not supposed to happen ; ; Get First name NEW GIVEN SET GIVEN=$$object^C0XGET1(NAMENODE,"v:given-name") IF '$L(GIVEN) SET $EC=",U1," ; ditto ; ; Get Additional name (?Middle?) NEW MIDDLE SET MIDDLE=$$object^C0XGET1(NAMENODE,"v:additional-name") ; This is optional of course ; QUIT $$UP^XLFSTR(FAMILY_","_GIVEN_" "_MIDDLE) ; ; DOB(DEMID) ; Public $$; Return Timson Date for DOB given the Dem node ID. ; IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in. ; ; Get DOB. NEW DOB S DOB=$$object^C0XGET1(DEMID,"v:bday") IF '$L(DOB) SET $EC=",U1," ; ditto ; ; Convert to Timson Date using %DT N X,Y,%DT S X=DOB D ^%DT QUIT Y ; ; SEX(DEMID) ; Public $$; Return Sex M or F given the demographics node ID. ; IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in. ; ; Get "gender" NEW SEX S SEX=$$object^C0XGET1(DEMID,"foaf:gender") IF '$L(SEX) SET $EC=",U1," ; ditto ; ; Convert to internal value N SEXABBR ; Sex Abbreviation D CHK^DIE(2,.02,,SEX,.SEXABBR) ; Check value and convert to internal ; IF SEXABBR="^" QUIT "F" ; Unknown sexes will be female (Sam sez so) ELSE QUIT SEXABBR ; ; MRN(DEMID) ; Public $$; Return the Medical Record Number given node ID. ; IF '$DATA(DEMID) SET $EC=",U1," ; Must pass this in. ; ; Get subject node, then the identifer under it. NEW MRNNODE S MRNNODE=$$object^C0XGET1(DEMID,"sp:medicalRecordNumber") NEW MRN S MRN=$$object^C0XGET1(MRNNODE,"dcterms:identifier") ; ; If it doesn't exist, invent one I '$L(MRN) S MRN=$R(928749018234) QUIT MRN ; ADDPT(RETURN,PARAM) ; Private Proc; Add Patient to VISTA. ; Return RPC style return pass by reference. Pass empty. ; PARAM passed by reference. ; Required elements include: ; PARAM("NAME")=NAME (last name minimal; recommend full name) ; PARAM("GENDER")=SEX ; PARAM("DOB")=DATE OF BIRTH ; PARAM("MRN")=MEDICAL RECORD NUMBER ; ; Optional elements include: ; PARAM("POBCTY")=PLACE OF BIRTH [CITY] ; PARAM("POBST")=PLACE OF BIRTH [STATE] ; PARAM("MMN")=MOTHER'S MAIDEN NAME ; PARAM("ALIAS",#)=ALIAS NAME(last^first^middle^suffix)^ALIAS SSN ; ; These elements are calculated: ; PARAM("PRFCLTY")=PREFERRED FACILITY ; PARAM("SSN")=SOCIAL SECURITY NUMBER OR NULL IF NONE ; PARAM("SRVCNCTD")=SERVICE CONNECTED? ; PARAM("TYPE")=TYPE ; PARAM("VET")=VETERAN (Y/N)? ; PARAM("FULLICN")=INTEGRATION CONTROL NUMBER AND CHECKSUM ; ;CHECK THAT PATCH DG*5.3*800 is installed for routine VAFCPTAD to add pt. I '$$PATCH^XPDUTL("DG*5.3*800") D EN^DDIOL("You need to have patch DG*5.3*800 to add patients") S $EC=",U1," ; ; Crash if required params aren't present N X F X="NAME","GENDER","DOB","MRN" S:'$D(PARAM(X)) $EC=",U1," ; ; Calculate ICN and its checksum using MRN; then remove MRN. S PARAM("FULLICN")=PARAM("MRN")_"V"_$$CHECKDG^MPIFSPC(PARAM("MRN")) ; ; Get Preferred Facility from this Facility's number. S PARAM("PRFCLTY")=$P($$SITE^VASITE(),U,3) ; Must use Station number here for API. I 'PARAM("PRFCLTY") S $EC=",U1," ; crash if Facility is not set-up properly. ; ; No SSN (for now) S PARAM("SSN")="" ; ; Boiler plate stuff below: ; TODO: This could be configurable in a File. WV uses "VISTA OFFICE EHR" S PARAM("SRVCNCTD")="N" S PARAM("TYPE")="NON-VETERAN (OTHER)" S PARAM("VET")="N" ; ; Now for the finish. Add the patient to VISTA (but only adds it to 2 :-() D ADD^VAFCPTAD(.RETURN,.PARAM) ; I +RETURN(1)=-1 S $EC=",U1," ; It failed. E N PIEN S PIEN=$P(RETURN(1),U,2) ; ; Add to IHS Patient file using Laygo in case it's already there. NEW C0XFDA SET C0XFDA(9000001,"?+"_PIEN_",",.01)=PIEN SET C0XFDA(9000001,"?+"_PIEN_",",.02)=DT SET C0XFDA(9000001,"?+"_PIEN_",",.12)=DUZ ;logged in user IEN (e.g. "13") SET C0XFDA(9000001,"?+"_PIEN_",",.16)=DT DO UPDATE^DIE("",$NAME(C0XFDA)) I $D(^TMP("DIERR",$J)) S $EC=",U1," ; ; Add medical record number. NEW IENS S IENS="?+1,"_PIEN_"," NEW C0XFDA SET C0XFDA(9000001.41,IENS,.01)=+$$SITE^VASITE() ; This time, the IEN of the primary site SET C0XFDA(9000001.41,IENS,.02)=PARAM("MRN") ; Put Medical Record Number on Station Number DO UPDATE^DIE("",$NAME(C0XFDA)) I $D(^TMP("DIERR",$J)) S $EC=",U1," QUIT ; VITALS(G,DFN) ; Private EP; Process Vitals for a patient graph. ; Vital Sign Sets K ^TMP($J) ; Global variable. A patient can have 1000 vital sets. D GOPS^C0XGET3($NA(^TMP($J,"VS")),G,"sp:VitalSignSet","rdf:type") ; ; For each Vital Sign Set, grab encounter N S F S=0:0 S S=$O(^TMP($J,"VS",S)) Q:S="" D . N ENC S ENC=$$GSPO1^C0XGET3(G,^TMP($J,"VS",S),"sp:encounter") ; ; D EN1^GMVDCSAV(.RESULT,DATA) QUIT ; NP() ; New Person Entry Q:$O(^VA(200,"B","PROVIDER,UNKNOWN SMART",0)) $O(^(0)) ; Quit if the entry exists ; N C0XFDA,C0XIEN,C0XERR,DIERR S C0XFDA(200,"?+1,",.01)="PROVIDER,UNKNOWN SMART" ; Name S C0XFDA(200,"?+1,",1)="USP" ; Initials S C0XFDA(200,"?+1,",28)="SMART" ; Mail Code S C0XFDA(200.05,"?+2,?+1,",.01)="`144" ; Person Class - Allopathic docs. S C0XFDA(200.05,"?+2,?+1,",2)=2700101 ; Date active ; N DIC S DIC(0)="" ; An XREF in File 200 requires this. D UPDATE^DIE("E",$NA(C0XFDA),$NA(C0XIEN),$NA(C0XERR)) ; Typical UPDATE I $D(DIERR) S $EC=",U1," Q C0XIEN(1) ;Provider IEN ; HL() ; Hospital Location Entry N C0XFDA,C0XIEN,C0XERR,DIERR S C0XFDA(44,"?+1,",.01)="SMART PATIENT LOCATION" ; Name S C0XFDA(44,"?+1,",2)="C" ; Type - Clinic S C0XFDA(44,"?+1,",2.1)=1 ; Type Extension - Clinic S C0XFDA(44,"?+1,",3)=+$$SITE^VASITE() ; Institution - Default institution S C0XFDA(44,"?+1,",8)=295 ; STOP CODE NUMBER - Primary Care S C0XFDA(44,"?+1,",9)="M" ; SERVICE S C0XFDA(44,"?+1,",2502)="Y" ; NON-COUNT CLINIC D UPDATE^DIE("",$NA(C0XFDA),$NA(C0XIEN),$NA(C0XERR)) I $D(DIERR) S $EC=",U1," Q C0XIEN(1) ; HL IEN