Changeset 1205 for ccr/trunk/p

Timestamp:

Jul 8, 2011, 3:24:07 PM (13 years ago)

Author:

George Lilly

Message:

version for certification

Location:

ccr/trunk/p

Files:

• C0CALERT.m (modified) (1 diff)
• C0CCCR.m (modified) (3 diffs)
• C0CCCR0.m (modified) (1 diff)
• C0CLABS.m (modified) (3 diffs)
• C0CMAIL.m (added)
• C0CMAIL3.m (added)
• C0CMED3.m (modified) (6 diffs)
• C0CNMED2.m (added)
• C0CNMED4.m (modified) (3 diffs)
• C0CORSLT.m (added)
• C0CPROBS.m (modified) (2 diffs)
• C0CPROC.m (modified) (3 diffs)
• C0CUTIL.m (modified) (1 diff)

ccr/trunk/p/C0CALERT.m

@@ -82 +82 @@
         . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
         . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
+        . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
         . I ACVUID'="" D  ; IF VUID IS NOT NULL
         . . S ZC=$$CODE^C0CUTIL(ACVUID)

ccr/trunk/p/C0CCCR.m

@@ -103 +103 @@
         D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
         D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
+        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments")
         I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
         ;
@@ -134 +135 @@
         D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
         K ACTT,ACTT2
-        D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
-        D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
-        D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
+        ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
+        ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
+        ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
+        ; gpl - turned off Comments for Certification
         K CMTT,CMTT2
         N TRIMI,J,DONE S DONE=0
@@ -164 +166 @@
         D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
         D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
-        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
+        ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
+        ; gpl - turned off Encounters for Certification
         Q
         ;

ccr/trunk/p/C0CCCR0.m

@@ -792 +792 @@
         ;;</Name>
         ;;</Person>
-        ;;<IDs>
-        ;;<Type>
-        ;;<Text>@@IDTYPE@@</Text>
-        ;;</Type>
-        ;;<ID>@@ID@@</ID>
-        ;;<IssuedBy>
-        ;;<Description>
-        ;;<Text>@@IDDESC@@</Text>
-        ;;</Description>
-        ;;</IssuedBy>
-        ;;</IDs>
         ;;<Specialty>
         ;;<Text>@@ACTORSPECIALITY@@</Text>

ccr/trunk/p/C0CLABS.m

@@ -130 +130 @@
         S C0CQT=1 ; SURPRESS LISTING
         D LIST ; EXTRACT THE VARIABLES
+        ; FOR CERTIFICATION, SEE IF THERE ARE OTHER RESULTS TO ADD
+        D EN^C0CORSLT(C0CLB,DFN) ; LOOKS FOR ECG TESTS
         S C0CQT=QTSAV ; RESET SILENT FLAG
         K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
@@ -152 +154 @@
         W "LAB LIMIT: ",C0CLLMT,!
         D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
+        S C0CEDT=$$NOW^XLFDT ; PULL LABS STARTING NOW
         S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
         Q
@@ -172 +175 @@
         . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
         . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
+        . I $G(C0CVAR("RESULTCODINGSYSTEM"))="LN" D  ; gpl - for certification
+        . . S C0CVAR("RESULTCODINGSYSTEM")="LOINC" ; NEED TO SPELL IT OUT
+        . . N C0CRDT S C0CRDT=C0CVAR("RESULTDESCRIPTIONTEXT") ; THE DESCRIPTION
+        . . N C0CRCD S C0CRCD=C0CVAR("RESULTCODE") ; THE LOINC CODE
+        . . S C0CVAR("RESULTDESCRIPTIONTEXT")=C0CRDT_" LOINC: "_C0CRCD
         . M XV=C0CVAR ;
         . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION

ccr/trunk/p/C0CMED3.m

@@ -71 +71 @@
         . S @MAP@("MEDTYPETEXT")="Medication"
         . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
-        . S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
+        . S @MAP@("MEDSTATUSTEXT")="Active" ; nearest status for pending meds
         . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
         . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
@@ -114 +114 @@
         . . ; To protect against failure, I will put an if/else block
         . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
-        . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
+        . . ; 
+        . . ; begin changes for systems that have eRx installed
+        . . ; RxNorm is found in the ^C0P("RXN") global - gpl
+        . . ;
+        . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
+        . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
+        . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE
+        . . I NDFIEN,$D(^C0P("RXN")) D  ; 
+        . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
+        . . . S ZC=$$CODE^C0CUTIL(VUID)
+        . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
+        . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
+        . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
+        . . . S RXNORM=ZCD ; THE CODE
+        . . . S RXNNAME=ZCDS ; THE CODING SYSTEM
+        . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION
+        . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
+        . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD
+        . . E  I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
         . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
         . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
@@ -122 +140 @@
         . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
         . . ;
-        . . E  S (RXNORM,RXNNAME,RXNVER)=""
+        . . ;E  S (RXNORM,RXNNAME,RXNVER)=""
         . . ; End if/else block
         . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
@@ -161 +179 @@
         . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
         . . E  S @MAP@("MEDQUANTITYUNIT")=""
+        . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these
         . E  D
         . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
@@ -181 +200 @@
         . ; MEDDIRECTIONDESCRIPTIONTEXT
         . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
-        . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
+        . ;
+        . ; change for eRx meds - gpl 6/25/2011
+        . ;
+        . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
+        . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME
+        . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX
+        . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity
+        . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME
+        . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D  ; FIX THE DRUG NAME
+        . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME
+        . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM
+        . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY
+        . . I RXNORM'="" D  ;
+        . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM
+        . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM
+        . . . S RXNVER="" ; THE CODING SYSTEM VERSION
+        . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
+        . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM
+        . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
+        . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
+        . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
+        . . . I RXNORM["979334" D  ; PATCH FOR CERTIFICATION
+        . . . . S @MAP@("MEDSTRENGTHVALUE")=650
+        . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"
+        . . . . S @MAP@("MEDFORMTEXT")="INHALER"
+        . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS
+        . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY
+        . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;
+        . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
         . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
         . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
@@ -213 +260 @@
         . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
         . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
+        . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl
         . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
         . K @RESULT

ccr/trunk/p/C0CNMED4.m

@@ -83 +83 @@
  . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
  . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
- . S @MAP@("MEDSTATUSTEXT")=$G(MED("vaStatus@value")) ; need to filter status
+ . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status
+ . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active"
+ . I C0CMST="ACTIVE" S C0CMST="Active" ;
+ . S @MAP@("MEDSTATUSTEXT")=C0CMST
  . ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
  . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code"))
@@ -112 +115 @@
  . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
  . ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
- . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("dose.dose@dose"))
+ . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose"))
  . ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
- . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("dose.dose@units"))
+ . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units"))
  . ; Units, concentration, etc, come from another call
  . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
@@ -135 +138 @@
  . S @MAP@("MEDFORMTEXT")=$G(MED("form@value"))
  . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
- . S @MAP@("MEDCONCVALUE")=$G(MED("dose.dose@dose"))
+ . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose"))
  . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
- . S @MAP@("MEDCONCUNIT")=$G(MED("dose.does@units"))
+ . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units"))
  . ;S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
- . S @MAP@("MEDQUANTITYVALUE")=""
+ . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ;
  . ; Oddly, there is no easy place to find the dispense unit.
  . ; It's not included in the original call, so we have to go to the drug file.

ccr/trunk/p/C0CPROBS.m

@@ -60 +60 @@
         . S @VMAP@("PROBLEMCODINGVERSION")=""
         . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3)
+        . ; FOR CERTIFICATION - GPL
+        . I @VMAP@("PROBLEMCODEVALUE")=493.90 S @VMAP@("PROBLEMCODEVALUE")=493
         . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")
         . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")
@@ -110 +112 @@
         . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")
         . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG
-        . S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
+        . ; turn off acute/chronic for certification gpl
+        . ;S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
         . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
         . S @VMAP@("PROBLEMCODINGVERSION")=""
         . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
+        . ; FOR CERTIFICATION - GPL
+        . I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493
         . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
         . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")

ccr/trunk/p/C0CPROC.m

@@ -26 +26 @@
         S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
         S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
+        ; ADDITION FOR CERTIFICATION
+        S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))
         Q
         ;
@@ -78 +80 @@
         . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
         . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
+        . . . ; additions for Certification - need to have EKG in Results
+        . . . S ZRNF("PROCTEXT")=$G(VISIT(ZI,"TEXT",1)) ; POTENTIAL RESULT
         . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
         . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
@@ -83 +87 @@
         . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
         . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
+        . . . ; FOR CERTIFICATION - SAVE EKG RESULTS gpl
+        . . . W !,"CPT=",ZCPT
+        . . . I ZCPT["93000" D  ; THIS IS AN EKG
+        . . . . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
+        . . . . M ^GPL("RNF2")=@C0CPRSLT
         . . . S PREVCPT=ZCPT
         . . . S PREVDT=ZDATE

ccr/trunk/p/C0CUTIL.m

@@ -145 +145 @@
  S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
  N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
+ S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
+ I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
+ Q ZRSLT
+ ;
+NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO 
+ ; CONFORM TO NIST REQUIREMENTS
+ ;INPATIENT CERTIFICATION
  I ZRXN=309362 S ZRXN=213169
  I ZRXN=855318 S ZRXN=855320
  I ZRXN=197361 S ZRXN=212549
- I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
- Q ZRSLT
+ ;OUTPATIENT CERTIFICATION
+ I ZRXN=310534 S ZRXN=205875
+ I ZRXN=617312 S ZRXN=617314
+ I ZRXN=310429 S ZRXN=200801
+ I ZRXN=628953 S ZRXN=628958
+ I ZRXN=745679 S ZRXN=630208
+ I ZRXN=311564 S ZRXN=979334
+ I ZRXN=836343 S ZRXN=836370
+ Q ZRXN
  ;
 RPMS()  ; Are we running on an RPMS system rather than Vista?