Changeset 435 for ccr/trunk/p
- Timestamp:
- Apr 20, 2009, 11:00:43 PM (16 years ago)
- Location:
- ccr/trunk/p
- Files:
-
- 4 edited
-
C0CLA7Q.m (modified) (7 diffs)
-
C0CLABS.m (modified) (1 diff)
-
C0CPARMS.m (modified) (1 diff)
-
LA7VOBX1.m (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
ccr/trunk/p/C0CLA7Q.m
r434 r435 12 12 ; 13 13 ; Check and retrieve lab results from LAB DATA file (#63) 14 DGCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7))14 S C0CDEST=$$GCPR^LA7QRY($G(C0CPTID),$G(C0CSDT),$G(C0CEDT),.C0CSC,.C0CSPEC,.C0CERR,$G(C0CDEST),$G(C0CHL7)) 15 15 ; 16 16 ; If V LAB file present then check for lab results that are only in this file … … 27 27 VCHECK ; If V LAB file present then check for lab results that are only in this file. 28 28 ; 29 N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC RC,LA7SPEC,TMP29 N C0CDA,C0CEND,C0CROOT,C0CVLAB,LA7PTID,LA7SC,LA7SCRC,LA7SPEC 30 30 ; 31 31 S LA7PTID=C0CPTID … … 34 34 ; 35 35 ; Resolve search codes to lab datanames 36 S LA7SCSRC=$G(C0CSC) 37 S TMP=$$SCLIST^LA7QRY2(LA7SCSRC) 38 Q:$D(LA7ERR) "" 39 S LA7SC=TMP D:LA7SC'="*" CHKSC^LA7QRY1 36 S LA7SC=$G(C0CSC) 37 I $T(SCLIST^LA7QRY2)'="" D 38 . N TMP 39 . S LA7SCSRC=$G(C0CSC) 40 . S TMP=$$SCLIST^LA7QRY2(LA7SCSRC) 41 . S LA7SC=TMP 42 ; 43 I LA7SC'="*" D CHKSC^LA7QRY1 40 44 ; 41 45 ; Convert specimen codes to file #61 Topography entries … … 43 47 I LA7SPEC'="*" D SPEC^LA7QRY1 44 48 ; 45 S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C OCSDT)",C0CEND=049 S C0CROOT="^AUPNVLAB(""ALR4"",DFN,C0CSDT)",C0CEND=0 46 50 ; 47 51 F S C0CROOT=$Q(@C0CROOT) Q:C0CROOT="" D Q:C0CEND 48 52 . I $QS(C0CROOT,1)'="ALR4"!($QS(C0CROOT,2)'=DFN) S C0CEND=1 Q ; Left x-ref or patient 49 53 . I $QS(C0CROOT,3)>C0CEDT S C0CEND=1 Q ; Exceeded end date/time 50 . S C0CDA=$QS(C0CROOT, 6)54 . S C0CDA=$QS(C0CROOT,4) 51 55 . I $D(^TMP("C0C-VLAB",$J,1,C0CDA)) Q ; Already checked during scan of file #63 52 56 . D VCHK1 … … 65 69 ; Call from LA7QRY2 66 70 ; 67 N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN, X71 N DFN,C0C60,C0C63,C0CACC,C0CDA,C0CDT,C0CLN,C0CPDA,C0CPTEST,C0CTEST,X 68 72 ; 69 73 S DFN=$P(^LR(LRDFN,0),"^",3) … … 78 82 . I C0CDA<1 Q 79 83 . S C0CLN=$P($G(^AUPNVLAB(C0CDA,11)),"^",13) 84 . S C0CPDA=$P($G(^AUPNVLAB(C0CDA,12)),"^",8) 85 . I C0CPDA="" S C0CPDA=C0CDA 86 . S C0CTEST=$P($G(^AUPNVLAB(C0CDA,0)),"^") 87 . S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^") 80 88 . S ^TMP("C0C-VLAB",$J,1,C0CDA)="" 81 . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CLN_"^"_C0CDA 89 . I C0CDA'=C0CPDA S ^TMP("C0C-VLAB",$J,1,C0CPDA)="" 90 . S ^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)=C0CLN_"^"_C0CDA_"^"_C0CTEST_"^"_C0CPDA_"^"_C0CPTEST 82 91 ; 83 92 ; If LOINC found then update variable with LN code … … 104 113 VSTORE ; Store entry for building in HL7 message when parent is from V LAB file. 105 114 ; 106 N PARENT115 N C0CPDA,C0CPTEST 107 116 ; 108 117 ; Determine parent test to use for OBR segment 109 S PARENT=$P(C0CVLAB(12),"^",8)110 I PARENT="" S PARENT=$P(C0CVLAB(0),"^")118 S C0CPDA=$P(C0CVLAB(12),"^",8) 119 I C0CPDA="" S C0CPDA=C0CDA 111 120 ; 112 ; patient ien 113 ; | collection date/time 114 ; | | parent test (ordered test) 115 ; | | | ien of entry in V LAB file 116 ; | | | | 117 S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),PARENT,C0CDA)="" 121 ; Determine parent test 122 S C0CPTEST=$P($G(^AUPNVLAB(C0CPDA,0)),"^") 123 ; 124 S ^TMP("C0C-VLAB",$J,3,$P(C0CVLAB(0),"^",2),$P(C0CVLAB(12),"^"),C0CPTEST,C0CDA)=C0CPDA 118 125 ; 119 126 Q -
ccr/trunk/p/C0CLABS.m
r415 r435 153 153 W "LAB LIMIT: ",C0CLLMT,! 154 154 D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM 155 S C0CR=$$ GCPR^LA7QRY(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP155 S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP 156 156 Q 157 157 ; -
ccr/trunk/p/C0CPARMS.m
r422 r435 1 1 C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 2 ;;0.3;CCDCCR;nopatch;noreleasedate 3 ;Copyright 2008 WorldVistA. 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 ; 20 20 SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 21 ; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC" 22 ; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS 23 ; 24 N PTMP ; 25 S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN 26 ;K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL 27 I $G(INPARMS)'="" D ; OVERRIDES PROVIDED 28 . N C0CI S C0CI="" 29 . N C0CN S C0CN=1 30 . F S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI="" D ; 31 . . S C0CN=C0CN+1 ;NEXT PARM 32 . . N C1,C2 33 . . S C1=$P(C0CI,":",1) ; PARAMETER 34 . . S C2=$P(C0CI,":",2) ; VALUE 35 . . I C2="" S C2=1 36 . . S @C0CPARMS@(C1)=C2 37 . I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE 38 ; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS 39 ; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS 40 I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH 41 I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY 42 I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS 43 I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY 44 I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY 45 I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS 46 I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES 47 I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO 48 I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE 49 Q 50 ; 51 51 CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET 52 53 54 55 56 52 ; 53 I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN 54 I '$D(@C0CPARMS) D SET("SETWITHCHECK:1") 55 Q 56 ; 57 57 GET(WHICHP) ;EXTRINSIC TO RETURN THE VALUE OF PARAMETER WHICHP 58 59 60 61 62 58 ; 59 D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE 60 N GTMP 61 Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE 62 ; -
ccr/trunk/p/LA7VOBX1.m
r434 r435 1 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/1 3/091 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/14/09 2 2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;Sep 27, 1994 3 3 ; JMC - mods to check for IHS V LAB file … … 23 23 S LA7X=$P(LA7VAL,"^",3) 24 24 ; Check for no LOINC in 63 and LOINC found in V LAB file. 25 I $P(LA7X,"!",3)="",$D(^TMP(" LA7-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) S $P(LA7X,"!",3)=$P(^TMP("LA7-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB),"^")25 I $P(LA7X,"!",3)="",$D(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB)) S $P(LA7X,"!",3)=$P(^TMP("C0C-VLAB",$J,2,LRDFN,LRSS,LRIDT,LRSB),"^") 26 26 ; 27 27 I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
Note:
See TracChangeset
for help on using the changeset viewer.
