Changeset 1205 for ccr


Ignore:
Timestamp:
Jul 8, 2011, 3:24:07 PM (13 years ago)
Author:
George Lilly
Message:

version for certification

Location:
ccr/trunk/p
Files:
4 added
9 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/C0CALERT.m

    r1204 r1205  
    8282        . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
    8383        . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
     84        . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
    8485        . I ACVUID'="" D  ; IF VUID IS NOT NULL
    8586        . . S ZC=$$CODE^C0CUTIL(ACVUID)
  • ccr/trunk/p/C0CCCR.m

    r1204 r1205  
    103103        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
    104104        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
     105        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments")
    105106        I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
    106107        ;
     
    134135        D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
    135136        K ACTT,ACTT2
    136         D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
    137         D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
    138         D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
     137        ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
     138        ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
     139        ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
     140        ; gpl - turned off Comments for Certification
    139141        K CMTT,CMTT2
    140142        N TRIMI,J,DONE S DONE=0
     
    164166        D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
    165167        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
    166         D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
     168        ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
     169        ; gpl - turned off Encounters for Certification
    167170        Q
    168171        ;
  • ccr/trunk/p/C0CCCR0.m

    r1204 r1205  
    792792        ;;</Name>
    793793        ;;</Person>
    794         ;;<IDs>
    795         ;;<Type>
    796         ;;<Text>@@IDTYPE@@</Text>
    797         ;;</Type>
    798         ;;<ID>@@ID@@</ID>
    799         ;;<IssuedBy>
    800         ;;<Description>
    801         ;;<Text>@@IDDESC@@</Text>
    802         ;;</Description>
    803         ;;</IssuedBy>
    804         ;;</IDs>
    805794        ;;<Specialty>
    806795        ;;<Text>@@ACTORSPECIALITY@@</Text>
  • ccr/trunk/p/C0CLABS.m

    r1204 r1205  
    130130        S C0CQT=1 ; SURPRESS LISTING
    131131        D LIST ; EXTRACT THE VARIABLES
     132        ; FOR CERTIFICATION, SEE IF THERE ARE OTHER RESULTS TO ADD
     133        D EN^C0CORSLT(C0CLB,DFN) ; LOOKS FOR ECG TESTS
    132134        S C0CQT=QTSAV ; RESET SILENT FLAG
    133135        K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
     
    152154        W "LAB LIMIT: ",C0CLLMT,!
    153155        D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
     156        S C0CEDT=$$NOW^XLFDT ; PULL LABS STARTING NOW
    154157        S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
    155158        Q
     
    172175        . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
    173176        . D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
     177        . I $G(C0CVAR("RESULTCODINGSYSTEM"))="LN" D  ; gpl - for certification
     178        . . S C0CVAR("RESULTCODINGSYSTEM")="LOINC" ; NEED TO SPELL IT OUT
     179        . . N C0CRDT S C0CRDT=C0CVAR("RESULTDESCRIPTIONTEXT") ; THE DESCRIPTION
     180        . . N C0CRCD S C0CRCD=C0CVAR("RESULTCODE") ; THE LOINC CODE
     181        . . S C0CVAR("RESULTDESCRIPTIONTEXT")=C0CRDT_" LOINC: "_C0CRCD
    174182        . M XV=C0CVAR ;
    175183        . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
  • ccr/trunk/p/C0CMED3.m

    r1204 r1205  
    7171        . S @MAP@("MEDTYPETEXT")="Medication"
    7272        . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
    73         . S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
     73        . S @MAP@("MEDSTATUSTEXT")="Active" ; nearest status for pending meds
    7474        . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
    7575        . S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
     
    114114        . . ; To protect against failure, I will put an if/else block
    115115        . . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
    116         . . I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
     116        . . ;
     117        . . ; begin changes for systems that have eRx installed
     118        . . ; RxNorm is found in the ^C0P("RXN") global - gpl
     119        . . ;
     120        . . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
     121        . . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
     122        . . S (RXNORM,RXNNAME,RXNVER)="" ;INITIALIZE
     123        . . I NDFIEN,$D(^C0P("RXN")) D  ;
     124        . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
     125        . . . S ZC=$$CODE^C0CUTIL(VUID)
     126        . . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
     127        . . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
     128        . . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
     129        . . . S RXNORM=ZCD ; THE CODE
     130        . . . S RXNNAME=ZCDS ; THE CODING SYSTEM
     131        . . . S RXNVER=ZCDSV ; THE CODING SYSTEM VERSION
     132        . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
     133        . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_ZCDS_": "_ZCD
     134        . . E  I NDFIEN,$D(^C0CRXN) D  ; $Data is for Systems that don't have our RxNorm file yet.
    117135        . . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
    118136        . . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
     
    122140        . . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
    123141        . . ;
    124         . . E  S (RXNORM,RXNNAME,RXNVER)=""
     142        . . ;E  S (RXNORM,RXNNAME,RXNVER)=""
    125143        . . ; End if/else block
    126144        . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
     
    161179        . . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
    162180        . . E  S @MAP@("MEDQUANTITYUNIT")=""
     181        . . S @MAP@("MEDQUANTITYUNIT")="" ; don't show these
    163182        . E  D
    164183        . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
     
    181200        . ; MEDDIRECTIONDESCRIPTIONTEXT
    182201        . S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
    183         . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
     202        . ;
     203        . ; change for eRx meds - gpl 6/25/2011
     204        . ;
     205        . N ZERX S ZERX=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
     206        . I ZERX["|" S ZERX=$P(ZERX,"|",2) ; GET RID OF MED NAME
     207        . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=ZERX
     208        . N ZERX2 S ZERX2=$P(MED(2,"E"),"|",2) ; sig for quantity
     209        . N ZFDBDRUG S ZFDBDRUG=$P(MED(2,"E"),"|",1) ; FDB DRUG NAME
     210        . I @MAP@("MEDPRODUCTNAMETEXT")["FREE TXT" D  ; FIX THE DRUG NAME
     211        . . S @MAP@("MEDPRODUCTNAMETEXT")=ZFDBDRUG ; USE FDB NAME
     212        . . S RXNORM=$P($P($G(MED(14,7)),"RXNORM:",2)," ",1) ; THE RXNORM
     213        . . S RXNORM=$$NISTMAP^C0CUTIL(RXNORM) ; CHANGE IF NECESSARY
     214        . . I RXNORM'="" D  ;
     215        . . . W !,"FOUND FREE TEXT RXNORM:",RXNORM
     216        . . . S RXNNAME="RXNORM" ; THE CODING SYSTEM
     217        . . . S RXNVER="" ; THE CODING SYSTEM VERSION
     218        . . . N ZGMED S ZGMED=@MAP@("MEDPRODUCTNAMETEXT")
     219        . . . S @MAP@("MEDPRODUCTNAMETEXT")=ZGMED_" "_RXNNAME_": "_RXNORM
     220        . . . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
     221        . . . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
     222        . . . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
     223        . . . I RXNORM["979334" D  ; PATCH FOR CERTIFICATION
     224        . . . . S @MAP@("MEDSTRENGTHVALUE")=650
     225        . . . . S @MAP@("MEDSTRENGTHUNIT")="mcg"
     226        . . . . S @MAP@("MEDFORMTEXT")="INHALER"
     227        . S @MAP@("MEDQUANTITYUNIT")=$P(ZERX2," ",3) ; THE UNITS
     228        . S @MAP@("MEDQUANTITYVALUE")=$P(ZERX2," ",2) ; THE QUANTITY
     229        . I @MAP@("MEDFORMTEXT")="" S @MAP@("MEDFORMTEXT")=$P(ZERX2," ",3) ;
     230        . ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
    184231        . S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4"  ; means look in description text. See E2369-05.
    185232        . S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
     
    213260        . . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
    214261        . E  S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
     262        . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")="" ; don't put in these - gpl
    215263        . N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
    216264        . K @RESULT
  • ccr/trunk/p/C0CNMED4.m

    r1204 r1205  
    8383 . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
    8484 . ;S @MAP@("MEDSTATUSTEXT")="ACTIVE"
    85  . S @MAP@("MEDSTATUSTEXT")=$G(MED("vaStatus@value")) ; need to filter status
     85 . N C0CMST S C0CMST=$G(MED("vaStatus@value")) ; need to filter status
     86 . I C0CMST="EXPIRED" S C0CMST="Prior History No Longer Active"
     87 . I C0CMST="ACTIVE" S C0CMST="Active" ;
     88 . S @MAP@("MEDSTATUSTEXT")=C0CMST
    8689 . ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
    8790 . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code"))
     
    112115 . ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
    113116 . ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
    114  . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("dose.dose@dose"))
     117 . S @MAP@("MEDSTRENGTHVALUE")=$G(MED("doses.dose@dose"))
    115118 . ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
    116  . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("dose.dose@units"))
     119 . S @MAP@("MEDSTRENGTHUNIT")=$G(MED("doses.dose@units"))
    117120 . ; Units, concentration, etc, come from another call
    118121 . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
     
    135138 . S @MAP@("MEDFORMTEXT")=$G(MED("form@value"))
    136139 . ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
    137  . S @MAP@("MEDCONCVALUE")=$G(MED("dose.dose@dose"))
     140 . S @MAP@("MEDCONCVALUE")=$G(MED("doses.dose@dose"))
    138141 . ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
    139  . S @MAP@("MEDCONCUNIT")=$G(MED("dose.does@units"))
     142 . S @MAP@("MEDCONCUNIT")=$G(MED("doses.does@units"))
    140143 . ;S @MAP@("MEDQUANTITYVALUE")=""  ; not provided for in Non-VA meds.
    141  . S @MAP@("MEDQUANTITYVALUE")=""
     144 . S @MAP@("MEDQUANTITYVALUE")=$G(MED("doses.dose@unitsPerDose")) ;
    142145 . ; Oddly, there is no easy place to find the dispense unit.
    143146 . ; It's not included in the original call, so we have to go to the drug file.
  • ccr/trunk/p/C0CPROBS.m

    r1204 r1205  
    6060        . S @VMAP@("PROBLEMCODINGVERSION")=""
    6161        . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3)
     62        . ; FOR CERTIFICATION - GPL
     63        . I @VMAP@("PROBLEMCODEVALUE")=493.90 S @VMAP@("PROBLEMCODEVALUE")=493
    6264        . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")
    6365        . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")
     
    110112        . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")
    111113        . N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG
    112         . S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
     114        . ; turn off acute/chronic for certification gpl
     115        . ;S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
    113116        . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
    114117        . S @VMAP@("PROBLEMCODINGVERSION")=""
    115118        . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
     119        . ; FOR CERTIFICATION - GPL
     120        . I @VMAP@("PROBLEMCODEVALUE")["493.90" S @VMAP@("PROBLEMCODEVALUE")=493
    116121        . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
    117122        . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")
  • ccr/trunk/p/C0CPROC.m

    r1204 r1205  
    2626        S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
    2727        S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
     28        ; ADDITION FOR CERTIFICATION
     29        S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))
    2830        Q
    2931        ;
     
    7880        . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
    7981        . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
     82        . . . ; additions for Certification - need to have EKG in Results
     83        . . . S ZRNF("PROCTEXT")=$G(VISIT(ZI,"TEXT",1)) ; POTENTIAL RESULT
    8084        . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
    8185        . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
     
    8387        . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
    8488        . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
     89        . . . ; FOR CERTIFICATION - SAVE EKG RESULTS gpl
     90        . . . W !,"CPT=",ZCPT
     91        . . . I ZCPT["93000" D  ; THIS IS AN EKG
     92        . . . . D RNF1TO2^C0CRNF(C0CPRSLT,"ZRNF") ; SAVE FOR LABS
     93        . . . . M ^GPL("RNF2")=@C0CPRSLT
    8594        . . . S PREVCPT=ZCPT
    8695        . . . S PREVDT=ZDATE
  • ccr/trunk/p/C0CUTIL.m

    r1204 r1205  
    145145 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
    146146 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
     147 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
     148 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
     149 Q ZRSLT
     150 ;
     151NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
     152 ; CONFORM TO NIST REQUIREMENTS
     153 ;INPATIENT CERTIFICATION
    147154 I ZRXN=309362 S ZRXN=213169
    148155 I ZRXN=855318 S ZRXN=855320
    149156 I ZRXN=197361 S ZRXN=212549
    150  I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
    151  Q ZRSLT
     157 ;OUTPATIENT CERTIFICATION
     158 I ZRXN=310534 S ZRXN=205875
     159 I ZRXN=617312 S ZRXN=617314
     160 I ZRXN=310429 S ZRXN=200801
     161 I ZRXN=628953 S ZRXN=628958
     162 I ZRXN=745679 S ZRXN=630208
     163 I ZRXN=311564 S ZRXN=979334
     164 I ZRXN=836343 S ZRXN=836370
     165 Q ZRXN
    152166 ;
    153167RPMS()  ; Are we running on an RPMS system rather than Vista?
Note: See TracChangeset for help on using the changeset viewer.