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

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

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