source: fmts/trunk/p/C0XPT1.m@ 1717

Last change on this file since 1717 was 1620, checked in by Sam Habiel, 12 years ago

Added processing for encounters, pass 1
File size: 3.4 KB
Line 
1C0XPT1 ; VEN/SMH - Obtain and Store Problems ;2013-05-01 9:54 AM
2 ;;1.1;FILEMAN TRIPLE STORE;;
3 ; (C) Sam Habiel 2013
4 ; Proprietary code. Stay out!
5 ;
6PROBLEMS(G,DFN) ; Private EP; Process Problems for a patient graph
7 ; Delete existing problems if they are present
8 ; PS: This is a risky operation if somebody points to the original data.
9 ; PS2: Another idea is just to quit here if Patient has problems already.
10 I $D(^AUPNPROB("AC",DFN)) DO ; Patient already has problems.
11 . N DIK S DIK="^AUPNPROB(" ; Global to kill
12 . N DA F DA=0:0 S DA=$O(^AUPNPROB("AC",DFN,DA)) Q:'DA D ^DIK ; Kill each entry
13 ;
14 ; Process incoming problems
15 N RETURN ; Local return variable. I don't expect a patient to have more than 50 problems.
16 D ONETYPE^C0XGET3($NA(RETURN),G,"sp:Problem") ; Get all problems for patient
17 N S F S=0:0 S S=$O(RETURN(S)) Q:'S D ; For each problem
18 . N PROBNM S PROBNM=$$GSPO1^C0XGET3(G,RETURN(S),"sp:problemName") ; Snomed-CT coding info
19 . N CODEURL S CODEURL=$$GSPO1^C0XGET3(G,PROBNM,"sp:code") ; Snomed-CT Code URL
20 . N TEXT S TEXT=$$GSPO1^C0XGET3(G,PROBNM,"dcterms:title") ; Snomed-CT Code description
21 . ;
22 . N CODE ; Actual Snomed code rather than URL
23 . S CODE=$P(CODEURL,"/",$L(CODEURL,"/")) ; Get last / piece
24 . N EXPIEN ; IEN in the EXPESSION file
25 . N LEXS ; Return from Lex call
26 . D EN^LEXCODE(CODE) ; Lex API
27 . S EXPIEN=$P(LEXS("SCT",1),U) ; First match on Snomed CT. Crash if isn't present.
28 . ;
29 . N STARTDT S STARTDT=$$GSPO1^C0XGET3(G,RETURN(S),"sp:startDate") ; Start Date
30 . N X,Y,%DT S X=STARTDT D ^%DT S STARTDT=Y ; Convert STARTDT to internal format
31 . D PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add problem to VISTA.
32 QUIT
33 ;
34PROBADD(DFN,CODE,TEXT,EXPIEN,STARTDT) ; Add a problem to a patient's record.
35 ; Input
36 ; DFN - you know what that is
37 ; CODE - SNOMED code; not used alas; for the future.
38 ; TEXT - SNOMED Text
39 ; EXPIEN - IEN of Snomed CT Expression in the Expressions File (757.01)
40 ; STARTDT - Internal Date of when the problem was first noted.
41 ;
42 ; Output:
43 ; NONE
44 ; Crash expected if code fails to add a problem.
45 ;
46 ;
47 ;
48 N GMPDFN S GMPDFN=DFN ; patient dfn
49 ;
50 ; Add unknown provider to database
51 N GMPPROV S GMPPROV=$$NP^C0XPT0() ;Smart Provider IEN
52 ;
53 N GMPVAMC S GMPVAMC=$$KSP^XUPARAM("INST") ; Problem Institution. Ideally, the external one. But we are taking a shortcut here.
54 ;
55 N GMPFLD ; Input array
56 S GMPFLD(".01")="" ;Code IEN - API will assign 799.9.
57 ; .02 field (Patient IEN) not used. Pass variable GMPDFN instead.
58 S GMPFLD(".03")=DT ;Date Last Modified
59 S GMPFLD(".05")="^"_TEXT ;Expression text
60 S GMPFLD(".08")=DT ; today's date (entry?)
61 S GMPFLD(".12")="A" ;Active/Inactive
62 S GMPFLD(".13")=STARTDT ;Onset date
63 S GMPFLD("1.01")=EXPIEN_U_TEXT ;^LEX(757.01 ien,descip
64 S GMPFLD("1.03")=GMPPROV ;Entered by
65 S GMPFLD("1.04")=GMPPROV ;Recording provider
66 S GMPFLD("1.05")=GMPPROV ;Responsible provider
67 S GMPFLD("1.06")="" ; SERVICE FILE - LEAVE BLANK(#49)
68 S GMPFLD("1.07")="" ; Date resolved
69 S GMPFLD("1.08")="" ; Clinic (#44)
70 S GMPFLD("1.09")=DT ;entry date
71 S GMPFLD("1.1")=0 ;Service Connected
72 S GMPFLD("1.11")=0 ;Agent Orange exposure
73 S GMPFLD("1.12")=0 ;Ionizing radiation exposure
74 S GMPFLD("1.13")=0 ;Persian Gulf exposure
75 S GMPFLD("1.14")="C" ;Accute/Chronic (A,C)
76 S GMPFLD("1.15")="" ;Head/neck cancer
77 S GMPFLD("1.16")="" ;Military sexual trauma
78 S GMPFLD("10",0)=0 ; Note. No note.
79 ;
80 ;
81 N DA ; Return variable
82 D NEW^GMPLSAVE ; API call
83 I '$D(DA) S $EC=",U1," ; Fail here if API fails.
84 QUIT
85 ;
86 ;
Note: See TracBrowser for help on using the repository browser.