Changeset 1206 for ccr/trunk/p/C0CPROC.m


Ignore:
Timestamp:
Jul 15, 2011, 4:47:06 PM (13 years ago)
Author:
George Lilly
Message:

removed tabs after certification

File:
1 edited

Legend:

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

    r1205 r1206  
    1 C0CPROC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
    2         ;;1.0;C0C;;Jan 21, 2010;Build 38
    3         ;Copyright 2010 George Lilly, University of Minnesota and others.
    4         ;Licensed under the terms of the GNU General Public License.
    5         ;See attached copy of the License.
    6         ;
    7         ;This program is free software; you can redistribute it and/or modify
    8         ;it under the terms of the GNU General Public License as published by
    9         ;the Free Software Foundation; either version 2 of the License, or
    10         ;(at your option) any later version.
    11         ;
    12         ;This program is distributed in the hope that it will be useful,
    13         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15         ;GNU General Public License for more details.
    16         ;
    17         ;You should have received a copy of the GNU General Public License along
    18         ;with this program; if not, write to the Free Software Foundation, Inc.,
    19         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20         ;
    21         W "NO ENTRY FROM TOP",!
    22         Q
    23         ;
    24 SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES
    25         S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))
    26         S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
    27         S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
    28         ; ADDITION FOR CERTIFICATION
    29         S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))
    30         Q
    31         ;
    32 EXTRACT(PROCXML,DFN,PROCOUT)    ; EXTRACT PROCEDURES INTO  XML TEMPLATE
    33         ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
    34         ;
    35         D SETVARS ; SET UP VARIABLES
    36         I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
    37         D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
    38         Q
    39         ;
    40 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE)        ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
    41         ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
    42         ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
    43         ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
    44         ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
    45         ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
    46         ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
    47         ;
    48         K VISIT,LST,NOTE,C0CLPRC
    49         ; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS
    50         ; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES
    51         D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
    52         ; NEED TO ADD START AND END DATES FROM PARAMETERS
    53         N ZI S ZI=""
    54         N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
    55         F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
    56         . N ZDATE
    57         . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
    58         . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
    59         . N ZPRV
    60         . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
    61         . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
    62         . N ZJ S ZJ=""
    63         . F  S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ=""  D  ;FOR EACH CPT SEG
    64         . . N ZRNF
    65         . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
    66         . . I ZCPT'="" D  ;IF CPT CODE IS PRESENT
    67         . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q  ; NO DUPS ALLOWED
    68         . . . W !,ZCPT," ",ZDATE," ",ZPRV
    69         . . . S ZRNF("PROCACTOROBJID")=ZPRV
    70         . . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)
    71         . . . S ZRNF("PROCCODE")=PROCCODE
    72         . . . S ZRNF("PROCCODESYS")="CPT-4"
    73         . . . S ZRNF("PROCDATETEXT")="Procedure Date"
    74         . . . S ZRNF("PROCDATETIME")=ZDATE
    75         . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
    76         . . . S ZRNF("PROCDESCOBJATTR")=""
    77         . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
    78         . . . S ZRNF("PROCDESCOBJATTRVAL")=""
    79         . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
    80         . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
    81         . . . 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
    84         . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
    85         . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
    86         . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
    87         . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
    88         . . . 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
    94         . . . S PREVCPT=ZCPT
    95         . . . S PREVDT=ZDATE
    96         N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
    97         M @ZRIM=@C0CPRC@("V")
    98         Q
    99         ;
    100 PRV(IARY)       ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
    101         N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
    102         F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
    103         . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
    104         . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
    105         I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
    106         Q ZRTN
    107         ;
    108 DATE(ISTR)      ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
    109         Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
    110         ;
    111 CPT(ISTR)       ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
    112         ; CPT^CATEGORY^TEXT
    113         N Z1,Z2,Z3,ZRTN
    114         S Z1=$P(ISTR,U,1)
    115         I Z1="" D  ;
    116         . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
    117         I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
    118         . ;S Z1=$P(ISTR,U,1)
    119         . S Z2=$P(ISTR,U,2)
    120         . S Z3=$P(ISTR,U,3)
    121         . S ZRTN=Z1_U_Z2_U_Z3
    122         E  S ZRTN=""
    123         Q ZRTN
    124         ;
    125 MAP(PROCXML,C0CPRC,PROCOUT)     ; MAP PROCEDURES XML
    126         ;
    127         N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
    128         K @ZTEMP
    129         N ZBLD
    130         S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
    131         D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
    132         N ZINNER
    133         D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
    134         N ZTMP,ZVAR,ZI
    135         S ZI=""
    136         F  S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI=""  D  ;FOR EACH PROCEDURE
    137         . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
    138         . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
    139         . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
    140         . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
    141         D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
    142         N ZZTMP
    143         D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
    144         K @ZTEMP,@ZBLD,@C0CPRC
    145         Q
    146        
     1C0CPROC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
     2 ;;1.0;C0C;;Jan 21, 2010;Build 38
     3 ;Copyright 2010 George Lilly, University of Minnesota and others.
     4 ;Licensed under the terms of the GNU General Public License.
     5 ;See attached copy of the License.
     6 ;
     7 ;This program is free software; you can redistribute it and/or modify
     8 ;it under the terms of the GNU General Public License as published by
     9 ;the Free Software Foundation; either version 2 of the License, or
     10 ;(at your option) any later version.
     11 ;
     12 ;This program is distributed in the hope that it will be useful,
     13 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     14 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15 ;GNU General Public License for more details.
     16 ;
     17 ;You should have received a copy of the GNU General Public License along
     18 ;with this program; if not, write to the Free Software Foundation, Inc.,
     19 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20 ;
     21 W "NO ENTRY FROM TOP",!
     22 Q
     23 ;
     24SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES
     25 S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))
     26 S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
     27 S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
     28 ; ADDITION FOR CERTIFICATION
     29 S C0CPRSLT=$NA(^TMP("C0CCCR",$J,"C0CPRSLT",DFN))
     30 Q
     31 ;
     32EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO  XML TEMPLATE
     33 ; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
     34 ;
     35 D SETVARS ; SET UP VARIABLES
     36 I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
     37 D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
     38 Q
     39 ;
     40TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
     41 ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
     42 ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
     43 ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
     44 ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
     45 ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
     46 ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
     47 ;
     48 K VISIT,LST,NOTE,C0CLPRC
     49 ; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS
     50 ; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES
     51 D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
     52 ; NEED TO ADD START AND END DATES FROM PARAMETERS
     53 N ZI S ZI=""
     54 N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
     55 F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
     56 . N ZDATE
     57 . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
     58 . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
     59 . N ZPRV
     60 . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
     61 . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
     62 . N ZJ S ZJ=""
     63 . F  S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ=""  D  ;FOR EACH CPT SEG
     64 . . N ZRNF
     65 . . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
     66 . . I ZCPT'="" D  ;IF CPT CODE IS PRESENT
     67 . . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q  ; NO DUPS ALLOWED
     68 . . . W !,ZCPT," ",ZDATE," ",ZPRV
     69 . . . S ZRNF("PROCACTOROBJID")=ZPRV
     70 . . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)
     71 . . . S ZRNF("PROCCODE")=PROCCODE
     72 . . . S ZRNF("PROCCODESYS")="CPT-4"
     73 . . . S ZRNF("PROCDATETEXT")="Procedure Date"
     74 . . . S ZRNF("PROCDATETIME")=ZDATE
     75 . . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
     76 . . . S ZRNF("PROCDESCOBJATTR")=""
     77 . . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
     78 . . . S ZRNF("PROCDESCOBJATTRVAL")=""
     79 . . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
     80 . . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
     81 . . . 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
     84 . . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
     85 . . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
     86 . . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
     87 . . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
     88 . . . 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
     94 . . . S PREVCPT=ZCPT
     95 . . . S PREVDT=ZDATE
     96 N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
     97 M @ZRIM=@C0CPRC@("V")
     98 Q
     99 ;
     100PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
     101 N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
     102 F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
     103 . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
     104 . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
     105 I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
     106 Q ZRTN
     107 ;
     108DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
     109 Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
     110 ;
     111CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
     112 ; CPT^CATEGORY^TEXT
     113 N Z1,Z2,Z3,ZRTN
     114 S Z1=$P(ISTR,U,1)
     115 I Z1="" D  ;
     116 . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
     117 I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
     118 . ;S Z1=$P(ISTR,U,1)
     119 . S Z2=$P(ISTR,U,2)
     120 . S Z3=$P(ISTR,U,3)
     121 . S ZRTN=Z1_U_Z2_U_Z3
     122 E  S ZRTN=""
     123 Q ZRTN
     124 ;
     125MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML
     126 ;
     127 N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
     128 K @ZTEMP
     129 N ZBLD
     130 S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
     131 D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
     132 N ZINNER
     133 D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
     134 N ZTMP,ZVAR,ZI
     135 S ZI=""
     136 F  S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI=""  D  ;FOR EACH PROCEDURE
     137 . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
     138 . S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
     139 . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
     140 . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
     141 D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
     142 N ZZTMP
     143 D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
     144 K @ZTEMP,@ZBLD,@C0CPRC
     145 Q
     146 
Note: See TracChangeset for help on using the changeset viewer.