Index: fmts/trunk/p/C0XGET3.m
===================================================================
--- fmts/trunk/p/C0XGET3.m	(revision 1602)
+++ fmts/trunk/p/C0XGET3.m	(revision 1602)
@@ -0,0 +1,29 @@
+C0XGET3 ; VEN/SMH - Sam's Getters... let's try to make them simple ;2013-01-25  4:59 PM
+ ;;1.1;FILEMAN TRIPLE STORE;
+ ;
+IEN(N) ; Public $$; Resolved IEN of a stored string such as "rdf:type" in Strings File
+ Q $$IENOF^C0XGET1($$EXT^C0XUTIL(N))
+ ;
+ ;
+ ;
+GOPS1(G,O,P) ; Public $$; Get Subject for A Graph/Object/Predicate combination
+ N S S S=$O(^C0X(101,"GOPS",$$IEN(G),$$IEN(O),$$IEN(P),""))
+ Q:S="" ""
+ Q ^C0X(201,S,0)
+GOPS(R,G,O,P) ; Public Proc; Get Subjects for A Graph/Object/Predicate combination
+ ; R is global style RPC reference
+ N S S S=""
+ F  S S=$O(^C0X(101,"GOPS",$$IEN(G),$$IEN(O),$$IEN(P),S)) Q:S=""  S @R@(S)=^C0X(201,S,0)
+ QUIT
+ONETYPE1(G,O) ; Public $$; Get Subject for Graph/Object of a specific type
+ ; This is a conveince call to GOPS1 with Predicate="rdf:type"
+ Q $$GOPS1(G,O,"rdf:type")
+ONETYPE(R,G,O) ; Public Proc; Get Subjects for Graph/Object of a specific type
+ ; R is global style RPC reference
+ ; This is a conveince call to GOPS with Predicate="rdf:type"
+ D GOPS(R,G,O,"rdf:type")
+ QUIT
+GSPO1(G,S,P) ; Public $$; Get Object for A Graph/Subject/Predicate combination
+ N O S O=$O(^C0X(101,"GSPO",$$IEN(G),$$IEN(S),$$IEN(P),""))
+ Q:O="" ""
+ Q ^C0X(201,O,0)
Index: fmts/trunk/p/C0XPT0.m
===================================================================
--- fmts/trunk/p/C0XPT0.m	(revision 1602)
+++ fmts/trunk/p/C0XPT0.m	(revision 1602)
@@ -0,0 +1,280 @@
+C0XPT0 ; VEN/SMH - Get patient data and do something about it ;2013-01-25  5:00 PM
+ ;;1.1;FILEMAN TRIPLE STORE;;
+ ;
+ ; Get all graphs
+ NEW RETURN
+ DO GRAPHS^C0XGET1(.RETURN) ; TODO: Return could be a global due to large data.
+ N I S I="" F  S I=$O(RETURN(I)) Q:I=""  D  ; For each IEN
+ . N G S G=""  F  S G=$O(RETURN(I,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
+ D ADDPT(.RETURN,.PARAM)
+ ZWRITE RETURN
+ N DFN S DFN=$P(RETURN(1),U,2)
+ D VITALS(G,DFN)
+ D PROBLEMS(G,DFN)
+ ;
+ 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^DILIBF(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
+ ;
+ ;TODO: 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")
+ ;
+ ; 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")
+ . ZWRITE ENC
+ ;
+ ; D EN1^GMVDCSAV(.RESULT,DATA)
+ QUIT
+ ;
+PROBLEMS(G,DFN) ; Private EP; Process Problems for a patient graph
+ N RETURN ; Local return variable. I don't expect a patient to have more than 50 problems.
+ D ONETYPE^C0XGET3($NA(RETURN),G,"sp:Problem") ; Get all problems for patient
+ N S F S=0:0 S S=$O(RETURN(S)) Q:'S  D  ; For each problem
+ . N PROBNM S PROBNM=$$GSPO1^C0XGET3(G,RETURN(S),"sp:problemName") ; Snomed-CT coding info
+ . N CODEURL S CODEURL=$$GSPO1^C0XGET3(G,PROBNM,"sp:code") ; Snomed-CT Code URL
+ . N TEXT S TEXT=$$GSPO1^C0XGET3(G,PROBNM,"dcterms:title") ; Snomed-CT Code description
+ . ;
+ . N CODE ; Actual Snomed code rather than URL
+ . S CODE=$P(CODEURL,"/",$L(CODEURL,"/")) ; Get last / piece
+ . N EXPIEN ; IEN in the EXPESSION file
+ . N LEXS ; Return from Lex call
+ . D EN^LEXCODE(CODE) ; Lex API
+ . ;S EXPIEN=$P(LEXS("SCT",1),U) ; First match on Snomed CT. Crash if isn't present.
+ . ;
+ . N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,RETURN(S),"sp:startDate") ; Start Date
+ . N X,Y,%DT S X=STARTDT D ^%DT S STARTDT=Y ; Convert STARTDT to internal format
+ . ZWRITE CODE
+ . ZWRITE TEXT
+ . ZWRITE STARTDT
+ QUIT
+PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add a problem to a patient's record.
+	; Input - DFN from Symbol Table
+	;
+	; Output - ISIRC [return code]
+	;          ISIRESUL(0)=1
+	;          ISIRESUL(1)=IEN
+	;
+	N GMPDFN S GMPDFN=DFN ; patient dfn
+	;
+	; Add unknown provider to database
+	N C0XFDA,C0XIEN,C0XERR
+	S C0XFDA(200,"?+1,",.01)="PROVIDER,UNKNOWN SMART" ; Name
+	S C0XFDA(200,"?+1,",1)="USP" ; Initials
+	S C0XFDA(200,"?+1,",28)="SMART" ; Mail Code
+	D UPDATE^DIE("E",$NA(C0XFDA),$NA(C0XIEN),$NA(C0XERR))
+	N GMPPROV S GMPPROV=C0XIEN(1) ;Provider IEN
+	;
+	N GMPVAMC S GMPVAMC=$$KSP^XUPARAM("INST")
+	;
+	N GMPFLD
+	S GMPFLD(".01")=ISIMISC("ICDIEN") ;Code IEN
+	S GMPFLD(".03")=0 ;hard set
+	S GMPFLD(".05")="^"_ISIMISC("EXPNM") ;Expression text
+	S GMPFLD(".08")=DT ; today's date (entry?)
+	S GMPFLD(".12")=ISIMISC("STATUS") ;Active/Inactive
+	S GMPFLD(".13")=ISIMISC("ONSET") ;Onset date
+	S GMPFLD("1.01")=ISIMISC("EXPIEN")_"^"_ISIMISC("EXPNM") ;^LEX(757.01 ien,descip
+	S GMPFLD("1.03")=ISIMISC("PROVIDER") ;Entered by
+	S GMPFLD("1.04")=ISIMISC("PROVIDER") ;Recording provider
+	S GMPFLD("1.05")=ISIMISC("PROVIDER") ;Responsible provider
+	S GMPFLD("1.06")=1018 ;MEDICAL SERVICE (#49)
+	S GMPFLD("1.07")="" ; Date resolved
+	S GMPFLD("1.08")="" ; Clinic (#44)
+	S GMPFLD("1.09")=DT ;entry date
+	S GMPFLD("1.1")=0 ;Service Connected
+	S GMPFLD("1.11")=0 ;Agent Orange exposure
+	S GMPFLD("1.12")=0 ;Ionizing radiation exposure
+	S GMPFLD("1.13")=0 ;Persian Gulf exposure
+	S GMPFLD("1.14")=ISIMISC("TYPE") ;Accute/Chronic (A,C)
+	S GMPFLD("1.15")="" ;Head/neck cancer
+	S GMPFLD("1.16")="" ;Military sexual trauma
+	S GMPFLD("10",0)=0 ;auto set ""
+	D NEW^GMPLSAVE
+	I '$D(DA) Q "-1^Error creating problem"
+	S ISIRESUL(0)=1
+	S ISIRESUL(1)=DA
+	Q 1
+ ; Example FDA
+ ; SAM(9000011,"88,",.01)="410.90"
+ ; SAM(9000011,"88,",.02)="RODGERS,RONALD"
+ ; SAM(9000011,"88,",.03)="JUN 13,2011"
+ ; SAM(9000011,"88,",.04)=""
+ ; SAM(9000011,"88,",.05)="Acute myocardial infarction, unspecified site, episode of care unspecified"
+ ; SAM(9000011,"88,",.06)="VOE OFFICE INSTITUTION"
+ ; SAM(9000011,"88,",.07)=2
+ ; SAM(9000011,"88,",.08)="MAY 29,2011"
+ ; SAM(9000011,"88,",.12)="INACTIVE"
+ ; SAM(9000011,"88,",.13)="MAY 29,2011"
+ ; SAM(9000011,"88,",1.01)="Acute myocardial infarction, unspecified site, episode of care unspecified"
+ ; SAM(9000011,"88,",1.02)="PERMANENT"
+ ; SAM(9000011,"88,",1.03)="COORDINATOR,ONE"
+ ; SAM(9000011,"88,",1.04)="COORDINATOR,ONE"
+ ; SAM(9000011,"88,",1.05)="COORDINATOR,ONE"
+ ; SAM(9000011,"88,",1.06)="MEDICINE"
+ ; SAM(9000011,"88,",1.07)="JUN 13,2011"
+ ; SAM(9000011,"88,",1.08)=""
+ ; SAM(9000011,"88,",1.09)="MAY 29,2011"
+ ; SAM(9000011,"88,",1.1)="NO"
+ ; SAM(9000011,"88,",1.11)="NO"
+ ; SAM(9000011,"88,",1.12)="NO"
+ ; SAM(9000011,"88,",1.13)="NO"
+ ; SAM(9000011,"88,",1.14)="CHRONIC"
+ ; SAM(9000011,"88,",1.15)=""
+ ; SAM(9000011,"88,",1.16)=""
+ ; SAM(9000011,"88,",1.17)=""
+ ; SAM(9000011,"88,",1.18)=""