Changeset 764

Timestamp:

May 18, 2010, 3:43:43 PM (14 years ago)

Author:

George Lilly

Message:

includes C0CPROC AND C0CCPT

File:

• ccr/trunk/p/C0C_1_0_0_T22.KID (modified) (53 diffs)

ccr/trunk/p/C0C_1_0_0_T22.KID

@@ -1 @@
-KIDS Distribution saved on May 18, 2010@15:37:09
-includes de-identification mode for testing
+KIDS Distribution saved on May 18, 2010@16:32:54
+includes C0CPROC AND C0CCPT
 **KIDS**:C0C 1.0^
 
@@ -76 +76 @@
 
 "BLD",6967,6.3)
-34
+35
 "BLD",6967,"INI")
 PRE^C0CENV
@@ -130 +130 @@
 9.8
 "BLD",6967,"KRN",9.8,"NM",0)
-^9.68A^74^43
+^9.68A^76^45
 "BLD",6967,"KRN",9.8,"NM",22,0)
 C0CRXN^^0^B103277157
@@ -217 +217 @@
 "BLD",6967,"KRN",9.8,"NM",74,0)
 C0CIM2^^0^B20157375
+"BLD",6967,"KRN",9.8,"NM",75,0)
+C0CPROC^^0^B21479864
+"BLD",6967,"KRN",9.8,"NM",76,0)
+C0CCPT^^0^B13565934
 "BLD",6967,"KRN",9.8,"NM","B","C0CACTOR",47)
 
@@ -230 +234 @@
 
 "BLD",6967,"KRN",9.8,"NM","B","C0CCCR0",42)
+
+"BLD",6967,"KRN",9.8,"NM","B","C0CCPT",76)
 
 "BLD",6967,"KRN",9.8,"NM","B","C0CDPT",53)
@@ -268 +274 @@
 
 "BLD",6967,"KRN",9.8,"NM","B","C0CPROBS",39)
+
+"BLD",6967,"KRN",9.8,"NM","B","C0CPROC",75)
 
 "BLD",6967,"KRN",9.8,"NM","B","C0CQRY1",66)
@@ -86424 +86432 @@
 D XPZ2^XPDIQ
 "RTN")
-44
+46
 "RTN","C0CACTOR")
 0^47^B98962571
@@ -86430 +86438 @@
 C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
 "RTN","C0CACTOR",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CACTOR",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -86976 +86984 @@
 C0CALERT  ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
 "RTN","C0CALERT",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CALERT",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
@@ -87226 +87234 @@
 C0CBAT   ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
 "RTN","C0CBAT",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CBAT",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -87696 +87704 @@
 C0CCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
 "RTN","C0CCCD",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CCCD",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -88242 +88250 @@
 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
 "RTN","C0CCCD1",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CCCD1",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -88780 +88788 @@
 C0CCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
 "RTN","C0CCCR",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CCCR",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -89312 +89320 @@
 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
 "RTN","C0CCCR0",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CCCR0",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -91075 +91083 @@
 "RTN","C0CCCR0",883,0)
  ;</TEMPLATE>
+"RTN","C0CCPT")
+0^76^B13565934
+"RTN","C0CCPT",1,0)
+C0CCPT ;;BSL;RETURN CPT DATA;
+"RTN","C0CCPT",2,0)
+ ;Sequence Managers Software GPL;;;;;Build 35
+"RTN","C0CCPT",3,0)
+ ;Copied into C0C namespace from SQMCPT with permission from
+"RTN","C0CCPT",4,0)
+ ;Brian Lord - and with our thanks. gpl 01/20/2010
+"RTN","C0CCPT",5,0)
+ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
+"RTN","C0CCPT",6,0)
+ ;DFN=PATIENT IEN
+"RTN","C0CCPT",7,0)
+ ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
+"RTN","C0CCPT",8,0)
+ ;ENDDT=END DATE IN 3100101 FORMAT
+"RTN","C0CCPT",9,0)
+ ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
+"RTN","C0CCPT",10,0)
+ ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME 
+"RTN","C0CCPT",11,0)
+        ;ALL INCLUSIVE IN THAT DIRECTION
+"RTN","C0CCPT",12,0)
+        ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
+"RTN","C0CCPT",13,0)
+        ;BUILD INTO NOTE(Y)=""
+"RTN","C0CCPT",14,0)
+        S U="^",X=""
+"RTN","C0CCPT",15,0)
+        F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
+"RTN","C0CCPT",16,0)
+        . S Y=""
+"RTN","C0CCPT",17,0)
+        . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
+"RTN","C0CCPT",18,0)
+        .. S NOTE(Y)=""
+"RTN","C0CCPT",19,0)
+        ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
+"RTN","C0CCPT",20,0)
+        ;GET DATE OF NOTE
+"RTN","C0CCPT",21,0)
+        S Z=""
+"RTN","C0CCPT",22,0)
+        F  S Z=$O(NOTE(Z)) Q:Z=""  D
+"RTN","C0CCPT",23,0)
+        . S DT=$P(^TIU(8925,Z,0),U,7)
+"RTN","C0CCPT",24,0)
+        . I $G(STDT)]"" D
+"RTN","C0CCPT",25,0)
+        .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
+"RTN","C0CCPT",26,0)
+        . I $G(ENDDT)]"" D
+"RTN","C0CCPT",27,0)
+        .. I ENDDT<DT S NOTE(Z)="D"
+"RTN","C0CCPT",28,0)
+        . I NOTE(Z)="D" K NOTE(Z)
+"RTN","C0CCPT",29,0)
+ D VISIT
+"RTN","C0CCPT",30,0)
+        Q
+"RTN","C0CCPT",31,0)
+VISIT   ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
+"RTN","C0CCPT",32,0)
+ S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
+"RTN","C0CCPT",33,0)
+ S IEN=""  F  S IEN=$O(NOTE(IEN)) Q:IEN=""  D
+"RTN","C0CCPT",34,0)
+ . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
+"RTN","C0CCPT",35,0)
+ . S VISIT=$P(X12,U,7)
+"RTN","C0CCPT",36,0)
+ . I 'VISIT S VISIT=$P(X0,U,3)
+"RTN","C0CCPT",37,0)
+ . K ^TMP("PXKENC",$J)
+"RTN","C0CCPT",38,0)
+ . Q:VISIT=""!(VISIT'>0)
+"RTN","C0CCPT",39,0)
+ . D ENCEVENT^PXKENC(VISIT,1)
+"RTN","C0CCPT",40,0)
+ . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
+"RTN","C0CCPT",41,0)
+ . S IPRV=0 F  S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV  D
+"RTN","C0CCPT",42,0)
+ .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
+"RTN","C0CCPT",43,0)
+ .. ;Q:$P(X0,U,4)'="P"
+"RTN","C0CCPT",44,0)
+ .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
+"RTN","C0CCPT",45,0)
+ .. S PRIM=($P(X0,U,4)="P")
+"RTN","C0CCPT",46,0)
+ .. S ILST=ILST+1
+"RTN","C0CCPT",47,0)
+ .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
+"RTN","C0CCPT",48,0)
+ .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
+"RTN","C0CCPT",49,0)
+ . S IPOV=0 F  S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV  D
+"RTN","C0CCPT",50,0)
+ .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
+"RTN","C0CCPT",51,0)
+ .. S CODE=$P(X0,U)
+"RTN","C0CCPT",52,0)
+ .. S:CODE CODE=$P(^ICD9(CODE,0),U)
+"RTN","C0CCPT",53,0)
+ .. S CAT=$P(X802,U)
+"RTN","C0CCPT",54,0)
+ .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
+"RTN","C0CCPT",55,0)
+ .. S NARR=$P(X0,U,4)
+"RTN","C0CCPT",56,0)
+ .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
+"RTN","C0CCPT",57,0)
+ .. S PRIM=($P(X0,U,12)="P")
+"RTN","C0CCPT",58,0)
+ .. S PRV=$P(X12,U,4)
+"RTN","C0CCPT",59,0)
+ .. S ILST=ILST+1
+"RTN","C0CCPT",60,0)
+ .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
+"RTN","C0CCPT",61,0)
+ .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
+"RTN","C0CCPT",62,0)
+ . S ICPT=0 F  S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT  D
+"RTN","C0CCPT",63,0)
+ .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
+"RTN","C0CCPT",64,0)
+ .. ;S CODE=$P(X0,U)
+"RTN","C0CCPT",65,0)
+ .. S CODE=$O(^ICPT("B",$P(X0,U),0))
+"RTN","C0CCPT",66,0)
+ .. S:CODE CODE=$P(^ICPT(CODE,0),U)
+"RTN","C0CCPT",67,0)
+ .. S CAT=$P(X802,U)
+"RTN","C0CCPT",68,0)
+ .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
+"RTN","C0CCPT",69,0)
+ .. S NARR=$P(X0,U,4)
+"RTN","C0CCPT",70,0)
+ .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
+"RTN","C0CCPT",71,0)
+ .. S QTY=$P(X0,U,16)
+"RTN","C0CCPT",72,0)
+ .. S PRV=$P(X12,U,4)
+"RTN","C0CCPT",73,0)
+ .. S MCNT=0,MIDX=0,MODS=""
+"RTN","C0CCPT",74,0)
+ .. F  S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX  D
+"RTN","C0CCPT",75,0)
+ ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
+"RTN","C0CCPT",76,0)
+ ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
+"RTN","C0CCPT",77,0)
+ .. I +MCNT S MODS=MCNT_MODS
+"RTN","C0CCPT",78,0)
+ .. S ILST=ILST+1
+"RTN","C0CCPT",79,0)
+ .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
+"RTN","C0CCPT",80,0)
+ .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
+"RTN","C0CCPT",81,0)
+ . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
+"RTN","C0CCPT",82,0)
+ . I $G(TXT)=1 D GETNOTE(IEN)
+"RTN","C0CCPT",83,0)
+ Q
+"RTN","C0CCPT",84,0)
+GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
+"RTN","C0CCPT",85,0)
+ ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
+"RTN","C0CCPT",86,0)
+ Q:'$D(VISIT(IEN,"CPT"))
+"RTN","C0CCPT",87,0)
+ S TXTCNT=0
+"RTN","C0CCPT",88,0)
+ F  S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0))  D
+"RTN","C0CCPT",89,0)
+ . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
+"RTN","C0CCPT",90,0)
+ Q
 "RTN","C0CDPT")
 0^53^B45566634
@@ -91080 +91270 @@
 C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
 "RTN","C0CDPT",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CDPT",3,0)
  ;
@@ -91620 +91810 @@
 C0CENV ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009
 "RTN","C0CENV",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CENV",3,0)
  ;
@@ -92012 +92202 @@
 C0CFM1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
 "RTN","C0CFM1",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CFM1",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -92368 +92558 @@
 C0CFM2   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
 "RTN","C0CFM2",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CFM2",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -93094 +93284 @@
 C0CIM2  ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
 "RTN","C0CIM2",2,0)
- ;;1.0;C0C;;Feb 16, 2010;Build 34
+ ;;1.0;C0C;;Feb 16, 2010;Build 35
 "RTN","C0CIM2",3,0)
  ;Copyright 2010 George Lilly, University of Minnesota and others.
@@ -93362 +93552 @@
 C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
 "RTN","C0CIMMU",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CIMMU",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -93578 +93768 @@
 C0CIN   ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
 "RTN","C0CIN",2,0)
- ;;1.0;C0C;;Sep 20, 2009;Build 34
+ ;;1.0;C0C;;Sep 20, 2009;Build 35
 "RTN","C0CIN",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -93966 +94156 @@
 C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009
 "RTN","C0CLA7DD",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CLA7DD",3,0)
  ;
@@ -94486 +94676 @@
 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009
 "RTN","C0CLA7Q",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CLA7Q",3,0)
  ;
@@ -94826 +95016 @@
 C0CALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
 "RTN","C0CLABS",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CLABS",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -95608 +95798 @@
 C0CMCCD   ; GPL - MXML based CCD utilities;12/04/09  17:05
 "RTN","C0CMCCD",2,0)
- ;;0.1;C0C;nopatch;noreleasedate;Build 34
+ ;;0.1;C0C;nopatch;noreleasedate;Build 35
 "RTN","C0CMCCD",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -96190 +96380 @@
 C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
 "RTN","C0CMED",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CMED",3,0)
  ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
@@ -96384 +96574 @@
 C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
 "RTN","C0CMED1",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CMED1",3,0)
  ;;Last modified Sat Jan 10 21:42:27 PST 2009
@@ -96862 +97052 @@
 C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
 "RTN","C0CMED2",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CMED2",3,0)
  ;;Last Modified Sat Jan 10 21:41:14 PST 2009
@@ -97398 +97588 @@
 C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
 "RTN","C0CMED3",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CMED3",3,0)
  ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
@@ -97924 +98114 @@
 C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
 "RTN","C0CMED6",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CMED6",3,0)
  ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
@@ -98588 +98778 @@
 C0CMXML   ; GPL - MXML based XPath utilities;10/13/09  17:05
 "RTN","C0CMXML",2,0)
- ;;0.1;C0C;nopatch;noreleasedate;Build 34
+ ;;0.1;C0C;nopatch;noreleasedate;Build 35
 "RTN","C0CMXML",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -99040 +99230 @@
 C0CMXP   ; GPL - MXML based XPath utilities;12/04/09  17:05
 "RTN","C0CMXP",2,0)
- ;;0.1;C0C;nopatch;noreleasedate;Build 34
+ ;;0.1;C0C;nopatch;noreleasedate;Build 35
 "RTN","C0CMXP",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -99626 +99816 @@
 C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09
 "RTN","C0CPARMS",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CPARMS",3,0)
  ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
@@ -99752 +99942 @@
 C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
 "RTN","C0CPROBS",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CPROBS",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -100109 +100299 @@
 "RTN","C0CPROBS",180,0)
  ;
+"RTN","C0CPROC")
+0^75^B21479864
+"RTN","C0CPROC",1,0)
+C0CPROC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
+"RTN","C0CPROC",2,0)
+ ;;1.0;C0C;;Jan 21, 2010;Build 35
+"RTN","C0CPROC",3,0)
+ ;Copyright 2010 George Lilly, University of Minnesota and others.
+"RTN","C0CPROC",4,0)
+ ;Licensed under the terms of the GNU General Public License.
+"RTN","C0CPROC",5,0)
+ ;See attached copy of the License.
+"RTN","C0CPROC",6,0)
+ ;
+"RTN","C0CPROC",7,0)
+ ;This program is free software; you can redistribute it and/or modify
+"RTN","C0CPROC",8,0)
+ ;it under the terms of the GNU General Public License as published by
+"RTN","C0CPROC",9,0)
+ ;the Free Software Foundation; either version 2 of the License, or
+"RTN","C0CPROC",10,0)
+ ;(at your option) any later version.
+"RTN","C0CPROC",11,0)
+ ;
+"RTN","C0CPROC",12,0)
+ ;This program is distributed in the hope that it will be useful,
+"RTN","C0CPROC",13,0)
+ ;but WITHOUT ANY WARRANTY; without even the implied warranty of
+"RTN","C0CPROC",14,0)
+ ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+"RTN","C0CPROC",15,0)
+ ;GNU General Public License for more details.
+"RTN","C0CPROC",16,0)
+ ;
+"RTN","C0CPROC",17,0)
+ ;You should have received a copy of the GNU General Public License along
+"RTN","C0CPROC",18,0)
+ ;with this program; if not, write to the Free Software Foundation, Inc.,
+"RTN","C0CPROC",19,0)
+ ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+"RTN","C0CPROC",20,0)
+ ;
+"RTN","C0CPROC",21,0)
+ W "NO ENTRY FROM TOP",!
+"RTN","C0CPROC",22,0)
+ Q
+"RTN","C0CPROC",23,0)
+ ;
+"RTN","C0CPROC",24,0)
+EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO  XML TEMPLATE
+"RTN","C0CPROC",25,0)
+ ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
+"RTN","C0CPROC",26,0)
+ ;
+"RTN","C0CPROC",27,0)
+ S C0CENC=$NA(^TMP("C0CENC",$J,DFN))
+"RTN","C0CPROC",28,0)
+ S C0CPRC=$NA(^TMP("C0CPRC",$J,DFN))
+"RTN","C0CPROC",29,0)
+ S C0CNTE=$NA(^TMP("C0CNTE",$J,DFN))
+"RTN","C0CPROC",30,0)
+ I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
+"RTN","C0CPROC",31,0)
+ D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
+"RTN","C0CPROC",32,0)
+ Q
+"RTN","C0CPROC",33,0)
+ ;
+"RTN","C0CPROC",34,0)
+TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES, 
+"RTN","C0CPROC",35,0)
+ ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
+"RTN","C0CPROC",36,0)
+ ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
+"RTN","C0CPROC",37,0)
+ ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
+"RTN","C0CPROC",38,0)
+ ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY 
+"RTN","C0CPROC",39,0)
+ ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
+"RTN","C0CPROC",40,0)
+ ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
+"RTN","C0CPROC",41,0)
+ ;
+"RTN","C0CPROC",42,0)
+ K VISIT,LST,NOTE
+"RTN","C0CPROC",43,0)
+ D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
+"RTN","C0CPROC",44,0)
+ ; NEED TO ADD START AND END DATES FROM PARAMETERS
+"RTN","C0CPROC",45,0)
+ N ZI S ZI=""
+"RTN","C0CPROC",46,0)
+ N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
+"RTN","C0CPROC",47,0)
+ F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
+"RTN","C0CPROC",48,0)
+ . N ZDATE
+"RTN","C0CPROC",49,0)
+ . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
+"RTN","C0CPROC",50,0)
+ . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
+"RTN","C0CPROC",51,0)
+ . N ZPRV
+"RTN","C0CPROC",52,0)
+ . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
+"RTN","C0CPROC",53,0)
+ . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON 
+"RTN","C0CPROC",54,0)
+ . N ZJ S ZJ=""
+"RTN","C0CPROC",55,0)
+ . F  S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ=""  D  ;FOR EACH CPT SEG
+"RTN","C0CPROC",56,0)
+ . . N ZRNF
+"RTN","C0CPROC",57,0)
+ . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
+"RTN","C0CPROC",58,0)
+ . . I ZCPT'="" D  ;IF CPT CODE IS PRESENT
+"RTN","C0CPROC",59,0)
+ . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q  ; NO DUPS ALLOWED
+"RTN","C0CPROC",60,0)
+ . . . W !,ZCPT," ",ZDATE," ",ZPRV
+"RTN","C0CPROC",61,0)
+ . . . S ZRNF("PROCACTOROBJID")=ZPRV
+"RTN","C0CPROC",62,0)
+ . . . S ZRNF("PROCCODE")=$P(ZCPT,U,1)
+"RTN","C0CPROC",63,0)
+ . . . S ZRNF("PROCCODESYS")="CPT-4"
+"RTN","C0CPROC",64,0)
+ . . . S ZRNF("PROCDATETEXT")="Procedure Date"
+"RTN","C0CPROC",65,0)
+ . . . S ZRNF("PROCDATETIME")=ZDATE
+"RTN","C0CPROC",66,0)
+ . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
+"RTN","C0CPROC",67,0)
+ . . . S ZRNF("PROCDESCOBJATTR")=""
+"RTN","C0CPROC",68,0)
+ . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
+"RTN","C0CPROC",69,0)
+ . . . S ZRNF("PROCDESCOBJATTRVAL")=""
+"RTN","C0CPROC",70,0)
+ . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
+"RTN","C0CPROC",71,0)
+ . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
+"RTN","C0CPROC",72,0)
+ . . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
+"RTN","C0CPROC",73,0)
+ . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI
+"RTN","C0CPROC",74,0)
+ . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
+"RTN","C0CPROC",75,0)
+ . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
+"RTN","C0CPROC",76,0)
+ . . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
+"RTN","C0CPROC",77,0)
+ . . . S PREVCPT=ZCPT
+"RTN","C0CPROC",78,0)
+ . . . S PREVDT=ZDATE
+"RTN","C0CPROC",79,0)
+ N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
+"RTN","C0CPROC",80,0)
+ M @ZRIM=@C0CPRC@("V")
+"RTN","C0CPROC",81,0)
+ Q
+"RTN","C0CPROC",82,0)
+ ;
+"RTN","C0CPROC",83,0)
+PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
+"RTN","C0CPROC",84,0)
+ N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
+"RTN","C0CPROC",85,0)
+ F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
+"RTN","C0CPROC",86,0)
+ . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
+"RTN","C0CPROC",87,0)
+ . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
+"RTN","C0CPROC",88,0)
+ I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
+"RTN","C0CPROC",89,0)
+ Q ZRTN
+"RTN","C0CPROC",90,0)
+ ;
+"RTN","C0CPROC",91,0)
+DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
+"RTN","C0CPROC",92,0)
+ Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
+"RTN","C0CPROC",93,0)
+ ;
+"RTN","C0CPROC",94,0)
+CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
+"RTN","C0CPROC",95,0)
+ ; CPT^CATEGORY^TEXT
+"RTN","C0CPROC",96,0)
+ N Z1,Z2,Z3,ZRTN
+"RTN","C0CPROC",97,0)
+ S Z1=$P(ISTR,U,1) 
+"RTN","C0CPROC",98,0)
+ I Z1="" D  ;
+"RTN","C0CPROC",99,0)
+ . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
+"RTN","C0CPROC",100,0)
+ I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
+"RTN","C0CPROC",101,0)
+ . ;S Z1=$P(ISTR,U,1)
+"RTN","C0CPROC",102,0)
+ . S Z2=$P(ISTR,U,2)
+"RTN","C0CPROC",103,0)
+ . S Z3=$P(ISTR,U,3)
+"RTN","C0CPROC",104,0)
+ . S ZRTN=Z1_U_Z2_U_Z3
+"RTN","C0CPROC",105,0)
+ E  S ZRTN=""
+"RTN","C0CPROC",106,0)
+ Q ZRTN
+"RTN","C0CPROC",107,0)
+ ;
+"RTN","C0CPROC",108,0)
+MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML 
+"RTN","C0CPROC",109,0)
+ ;
+"RTN","C0CPROC",110,0)
+ N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
+"RTN","C0CPROC",111,0)
+ K @ZTEMP
+"RTN","C0CPROC",112,0)
+ N ZBLD
+"RTN","C0CPROC",113,0)
+ S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
+"RTN","C0CPROC",114,0)
+ D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
+"RTN","C0CPROC",115,0)
+ N ZINNER
+"RTN","C0CPROC",116,0)
+ D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
+"RTN","C0CPROC",117,0)
+ N ZTMP,ZVAR,ZI
+"RTN","C0CPROC",118,0)
+ S ZI=""
+"RTN","C0CPROC",119,0)
+ F  S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI=""  D  ;FOR EACH PROCEDURE
+"RTN","C0CPROC",120,0)
+ . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
+"RTN","C0CPROC",121,0)
+ . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
+"RTN","C0CPROC",122,0)
+ . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
+"RTN","C0CPROC",123,0)
+ . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
+"RTN","C0CPROC",124,0)
+ D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
+"RTN","C0CPROC",125,0)
+ N ZZTMP
+"RTN","C0CPROC",126,0)
+ D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
+"RTN","C0CPROC",127,0)
+ K @ZTEMP,@ZBLD,@C0CPRC
+"RTN","C0CPROC",128,0)
+ Q
+"RTN","C0CPROC",129,0)
+ ;  
 "RTN","C0CQRY1")
 0^66^B18992765
@@ -100114 +100564 @@
 LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
 "RTN","C0CQRY1",2,0)
-        ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 34
+        ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61**;Sep 27, 1994;Build 35
 "RTN","C0CQRY1",3,0)
         ;
@@ -100362 +100812 @@
 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
 "RTN","C0CQRY2",2,0)
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46**;Sep 27, 1994;Build 34
+ ;;5.2;AUTOMATED LAB INSTRUMENTS;**46**;Sep 27, 1994;Build 35
 "RTN","C0CQRY2",3,0)
  ; JMC - mods to check for IHS V LAB file
@@ -100732 +101182 @@
 C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
 "RTN","C0CRIMA",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CRIMA",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota.
@@ -101794 +102244 @@
 C0CRNF   ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
 "RTN","C0CRNF",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CRNF",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -102666 +103116 @@
 C0CRXN   ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
 "RTN","C0CRXN",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CRXN",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -103248 +103698 @@
 C0CSOAP  ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
 "RTN","C0CSOAP",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CSOAP",3,0)
  ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
@@ -103796 +104246 @@
 C0CSUB1   ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
 "RTN","C0CSUB1",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CSUB1",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -104070 +104520 @@
 C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
 "RTN","C0CSYS",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CSYS",3,0)
  ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
@@ -104190 +104640 @@
 C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
 "RTN","C0CUNIT",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CUNIT",3,0)
  ;Copyright 2008 George Lilly. Licensed under the terms of the GNU
@@ -104564 +105014 @@
 C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
 "RTN","C0CUTIL",2,0)
- ;;0.1;C0C;;Jun 15, 2008;Build 34
+ ;;0.1;C0C;;Jun 15, 2008;Build 35
 "RTN","C0CUTIL",3,0)
  ;Copyright 2008-2009 Sam Habiel & George Lilly.  
@@ -104832 +105282 @@
 C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
 "RTN","C0CVA200",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CVA200",3,0)
  ;Copyright 2008 Sam Habiel.  Licensed under the terms of the GNU
@@ -105170 +105620 @@
 C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
 "RTN","C0CVIT2",2,0)
- ;;1.0;C0C;;Feb 16, 2010;Build 34
+ ;;1.0;C0C;;Feb 16, 2010;Build 35
 "RTN","C0CVIT2",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
@@ -106128 +106578 @@
 C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
 "RTN","C0CVITAL",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CVITAL",3,0)
  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
@@ -106908 +107358 @@
 LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
 "RTN","C0CVOBX1",2,0)
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;Sep 27, 1994;Build 34
+ ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63**;Sep 27, 1994;Build 35
 "RTN","C0CVOBX1",3,0)
  ; JMC - mods to check for IHS V LAB file
@@ -107138 +107588 @@
 C0CXEWD   ; C0C/GPL - EWD based XPath utilities; 10/11/09
 "RTN","C0CXEWD",2,0)
- ;;0.1;C0C;nopatch;noreleasedate;Build 34
+ ;;0.1;C0C;nopatch;noreleasedate;Build 35
 "RTN","C0CXEWD",3,0)
  ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
@@ -107392 +107842 @@
 C0CXPAT0   ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
 "RTN","C0CXPAT0",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CXPAT0",3,0)
  ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
@@ -107818 +108268 @@
 C0CXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
 "RTN","C0CXPATH",2,0)
- ;;1.0;C0C;;May 19, 2009;Build 34
+ ;;1.0;C0C;;May 19, 2009;Build 35
 "RTN","C0CXPATH",3,0)
  ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU