source: ePrescribing/trunk/p/C0PNVA.m@ 1700

Last change on this file since 1700 was 1595, checked in by George Lilly, 12 years ago

initial release of ePrescribing
File size: 5.5 KB
Line 
1C0PNVA ; VEN/SMH - Non-VA Meds Utilities for e-Rx ; 5/8/12 4:32pm
2 ;;1.0;C0P;;Apr 25, 2012;Build 103
3 ;Copyright 2009 Sam Habiel. Licensed under the terms of the GNU
4 ;General Public License See attached copy of the License.
5 ;
6 ;This program is free software; you can redistribute it and/or modify
7 ;it under the terms of the GNU General Public License as published by
8 ;the Free Software Foundation; either version 2 of the License, or
9 ;(at your option) any later version.
10 ;
11 ;This program is distributed in the hope that it will be useful,
12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;GNU General Public License for more details.
15 ;
16 ;You should have received a copy of the GNU General Public License along
17 ;with this program; if not, write to the Free Software Foundation, Inc.,
18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19 Q
20 ;
21FILE(C0PDFN,OR,DRUG,DOSAGE,ROUTE,SCHEDULE,START,C0PDUZ,COMMENT) ; Private Proc - File NVA
22 ; Input:
23 ; - C0PDFN: Patient DFN
24 ; - OR: Pharmacy Orderable Item IEN
25 ; - DRUG: Drug IEN
26 ; - DOSAGE: Free Text Dosage
27 ; - ROUTE: Free Text Route
28 ; - SCHEDULE: Free Text Schedule
29 ; - START: Start date in Timson Format
30 ; - C0PDUZ: Provider documenting NVA DUZ
31 ; - COMMENT: Free Text Comment
32 ; NOTE: Right now, does nothing to file in CPRS order file.
33 ;
34 D CLEAN^DILF ; Kill DIERR etc
35 ; First Create parent file entry if it already doesn't exist
36 ;
37 ; We will handle the case where there are subfile entries but no
38 ; zero node defined for the record. First, check to see if there is
39 ; anything there at all for this patient
40 ;
41 N C0PEXIT S C0PEXIT=0 ; in case of errors
42 I '$D(^PS(55,C0PDFN)) D Q:C0PEXIT ; if nothing is there for this patient
43 . N C0PFDAPT
44 . N C0PPTIEN S C0PPTIEN(1)=C0PDFN ; bug? in Update-doesn't honor DINUM
45 . S C0PFDAPT(55,"+1,",.01)=C0PDFN
46 . D UPDATE^DIE("","C0PFDAPT","C0PPTIEN")
47 . I $G(DIERR) D ^%ZTER,CLEAN^DILF S C0PEXIT=1 Q ; log error and signal q
48 E I '$D(^PS(55,C0PDFN,0)) D ; is there something there but not a zero node?
49 . S ^PS(55,C0PDFN,0)=C0PDFN ; set the zero node
50 . N DIK,DA
51 . S DIK="^PS(55,"
52 . S DA=C0PDFN
53 . S DIK(1)=".01"
54 . D EN^DIK ; cross reference the .01 field
55 ;
56 N C0PFDA
57 N C0PIENS ; Return value of IEN in the NVA multiple in file 55
58 ;
59 ; gpl. first, create the NVA subfile if none exists
60 ; these lines were copied from PSONVNEW, which creates non-VA meds
61 N ZIEN ; CREATING A NEW ENTRY, THE FIRST FOR THIS PATIENT
62 I '$D(^PS(55,C0PDFN,"NVA",0)) D ; NO NVA SUBFILE
63 . S DFN=C0PDFN
64 . S DA(1)=DFN
65 . S X=OR
66 . S DR="1////"_DRUG
67 . S DIC("DR")=DR,DIC(0)="L",DIC="^PS(55,"_DFN_",""NVA"",",DLAYGO=55.05
68 . D FILE^DICN S ZIEN=+Y K DR,DIC,DD,DA,DO,DINUM
69 . ; I don't know why the following doesn't work
70 . ;S C0PFDA(55.05,"+1,"_C0PDFN_",",.01)=OR
71 . ;D UPDATE^DIE("","C0PFDA","C0PIENS")
72 . ;I $G(DIERR) D ^%ZTER QUIT ; log error if update fails
73 . ;E D ; find the ien of the subfile
74 . S ZIEN=$O(^PS(55,C0PDFN,"NVA","B",OR,""))
75 . I ZIEN="" S ZIEN=1
76 . ;
77 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",.01)=OR
78 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",1)=DRUG
79 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",2)=$E(DOSAGE,1,80) ; 80 char max
80 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",3)=$E(ROUTE,1,40)
81 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",4)=$E(SCHEDULE,1,50)
82 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",8)=START ; Start Date
83 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",11)=$$NOW^XLFDT() ; Documentated Date
84 . S C0PFDA(55.05,"?+"_ZIEN_","_C0PDFN_",",12)=C0PDUZ
85 . ;
86 . D UPDATE^DIE("","C0PFDA","C0PIENS")
87 . I $G(DIERR) D ^%ZTER QUIT ; log error if update fails
88 . ;
89 . D CLEAN^DILF ; Kill DIERR etc.
90 . ; File WP field
91 . N C0PWP ; comment is multi line
92 . M C0PWP=COMMENT
93 . ;D WP^DIE(55.05,C0PIENS(1)_","_C0PDFN_",",14,"","C0PWP")
94 . D WP^DIE(55.05,C0PIENS(ZIEN)_","_C0PDFN_",",14,"","C0PWP")
95 . I $G(DIERR) D ^%ZTER QUIT ; log error if wp filling fails.
96 E D ; CREATING A NEW ENTRY, NOT THE FIRST
97 . S ZIEN=1 ; GOING TO USE +1 CONVENTION
98 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",.01)=OR
99 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",1)=DRUG
100 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",2)=$E(DOSAGE,1,80) ; 80 char max
101 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",3)=$E(ROUTE,1,40)
102 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",4)=$E(SCHEDULE,1,50)
103 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",8)=START ; Start Date
104 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",11)=$$NOW^XLFDT() ; Documentated Date
105 . S C0PFDA(55.05,"+"_ZIEN_","_C0PDFN_",",12)=C0PDUZ
106 . ;
107 . D UPDATE^DIE("","C0PFDA","C0PIENS")
108 . ;I $D(GPLTEST) B ;
109 . I $G(DIERR) D ^%ZTER QUIT ; log error if update fails
110 . ;
111 . D CLEAN^DILF ; Kill DIERR etc.
112 . ; File WP field
113 . N C0PWP ;S C0PWP(1)=COMMENT
114 . M C0PWP=COMMENT ; comment is passed by reference and has multiple lines
115 . ;D WP^DIE(55.05,C0PIENS(1)_","_C0PDFN_",",14,"","C0PWP")
116 . D WP^DIE(55.05,C0PIENS(ZIEN)_","_C0PDFN_",",14,"","C0PWP")
117 . I $G(DIERR) D ^%ZTER QUIT ; log error if wp filling fails.
118 QUIT
119 ;
120DC(C0PDFN,NVAIEN) ; Private Procedure - D/C Non-VA Med
121 ; Input:
122 ; C0PDFN - you should know what this is by now
123 ; NVAIEN - IEN of Non-VA in the non-VA subfile in file 55
124 ; Output:
125 ; None
126 ; Notes: Does not involve order file right now...
127 I $G(^TMP("C0PNODISC")) Q ; DO NOT DISCONTINUE DRUGS SWITCH
128 ; FOR TESTING NEW CROP - MAINTAINS VISTA DRUGS
129 D CLEAN^DILF ; Kill DIERR etc
130 N C0PFDA
131 S C0PFDA(55.05,NVAIEN_","_C0PDFN_",",5)=1 ; Status = discontinued
132 S C0PFDA(55.05,NVAIEN_","_C0PDFN_",",6)=$$NOW^XLFDT() ; discontinued date
133 D UPDATE^DIE("","C0PFDA")
134 I $G(DIERR) D ^%ZTER QUIT
135 QUIT
Note: See TracBrowser for help on using the repository browser.