Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL09.m

    r613 r623  
    1 RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ; 3/13/06 9:24am
    2         ;;1.5;CLINICAL CASE REGISTRIES;**1,5**;Feb 17, 2006;Build 10
    3         ;
    4         ; 11/29/2007 BAY/KAM ROR*1.5*5 Rem Call 218601 Correct Outpatient
    5         ;                              CPTs not transmitting to the AAC
    6         ;
    7         ; This routine uses the following IAs:
    8         ;
    9         ; #93       Get stop code from the file #44 (controlled)
    10         ; #1889     Use of the ENCEVENT^PXKENC API
    11         ; #1995     $$CODEC^ICPTCOD (supported)
    12         ; #2309     Read access to the 'AA' x-ref in VISIT file (#9000010)
    13         ; #3990     $$CODEC^ICDCODE (supported)
    14         ; #10060    Read access to the file #200 (supported)
    15         ; #2438     Access to the file #40.8 (field #1) (controlled)
    16         ;
    17         Q
    18         ;
    19         ;***** PROCESSES DIAGNOSIS CODES
    20 DIAGS() ;
    21         N DIAG,IEN,K5,OID,REC,TMP
    22         S OID="OICD9"_RORCS_"Diagnosis"_RORCS_"VA080"
    23         S K5=""
    24         F  S K5=$O(^TMP("PXKENC",$J,RORIEN,"POV",K5))  Q:K5=""  D
    25         . S REC=^TMP("PXKENC",$J,RORIEN,"POV",K5,0)
    26         . S IEN=+$P(REC,U)  Q:IEN'>0
    27         . ;---
    28         . S DIAG=$$CODEC^ICDCODE(IEN)
    29         . D:DIAG'<0 SETOBX(OID,DIAG)
    30         Q 0
    31         ;
    32         ;***** OUTPATIENT DATA SEGMENT BUILDER
    33         ;
    34         ; RORDFN        DFN of Patient Record in File #2
    35         ;
    36         ; .DXDTS        Reference to a local variable where the
    37         ;               data extraction time frames are stored.
    38         ;
    39         ; RORTY         Set to either "PV1" or "OBR"
    40         ;
    41         ; The ^TMP("PXKENC",$J) and ^TMP("RORHL08",$J) global nodes are
    42         ; used by this function.
    43         ;
    44         ; Return Values:
    45         ;       <0  Error Code
    46         ;        0  Ok
    47         ;       >0  Non-fatal error(s)
    48         ;
    49 EN1(RORDFN,DXDTS,RORTY) ;
    50         N ERRCNT,PIEN,PV1CNT,RC
    51         S (ERRCNT,RC)=0
    52         ;
    53         ;--- PV1 Segments
    54         I RORTY="PV1"  K ^TMP("PXKENC",$J),^TMP("RORHL09",$J)  D
    55         . N IDX,INVDT,ROREND
    56         . S (IDX,PV1CNT)=0
    57         . F  S IDX=$O(DXDTS(2,IDX))  Q:IDX'>0  D  Q:RC<0
    58         . . S INVDT=9999999-$$FMADD^XLFDT($P(DXDTS(2,IDX),U)\1,-1)
    59         . . S ROREND=9999999-$P(DXDTS(2,IDX),U,2)
    60         . . F  S INVDT=$O(^AUPNVSIT("AA",RORDFN,INVDT),-1)  Q:'INVDT!(INVDT'>ROREND)  D
    61         . . . S PIEN=""
    62         . . . F  S PIEN=$O(^AUPNVSIT("AA",RORDFN,INVDT,PIEN),-1)  Q:'PIEN  D
    63         . . . . S TMP=$$PV1(PIEN,RORDFN)
    64         . . . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
    65         . . . . ;--- Reference for the corresponding OBR segment
    66         . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL09",$J,PV1CNT)=PIEN
    67         ;
    68         ;--- OBR and OBX Segments
    69         I RORTY="OBR"  D  K ^TMP("PXKENC",$J),^TMP("RORHL09",$J)
    70         . S PV1CNT=0
    71         . F  S PV1CNT=$O(^TMP("RORHL09",$J,PV1CNT))  Q:PV1CNT'>0  D
    72         . . S PIEN=+$G(^TMP("RORHL09",$J,PV1CNT))  Q:PIEN'>0
    73         . . ;---
    74         . . S TMP=$$OBR(PIEN,RORDFN)
    75         . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
    76         . . ;---
    77         . . S TMP=$$OBX(PIEN,RORDFN)
    78         . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
    79         ;
    80         ;--- Check for errors
    81         Q $S(RC<0:RC,1:ERRCNT)
    82         ;
    83         ;***** OBR SEGMENT BUILDER (OUTPATIENT)
    84         ;
    85         ; RORIEN        IEN of file #9000010
    86         ; RORDFN        DFN of Patient Record in File #2
    87         ;
    88         ; Return Values:
    89         ;       <0  Error Code
    90         ;        0  Ok
    91         ;       >0  Non-fatal error(s)
    92         ;
    93 OBR(RORIEN,RORDFN)      ;
    94         N CS,ERRCNT,RC,RORSEG,STN,TMP,VST0
    95         S (ERRCNT,RC)=0
    96         D ECH^RORHL7(.CS)
    97         ;
    98         S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
    99         ;
    100         ;--- Initialize the segment
    101         S RORSEG(0)="OBR"
    102         ;
    103         ;--- OBR-3 - Order Number (IEN in the VISIT file #9000010)
    104         S RORSEG(3)=RORIEN
    105         ;
    106         ;--- OBR-4 - Universal Service ID
    107         S RORSEG(4)="OP"_CS_"Outpatient"_CS_"C4"
    108         ;
    109         ;--- OBR-7 - Observation Date/Time (Visit Date/Time) *KEY*
    110         S TMP=$$FMTHL7^XLFDT($P(VST0,U))
    111         Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No visit date","ENCEVENT^PXKENC")
    112         S RORSEG(7)=TMP
    113         ;
    114         ;--- OBR-24 - Diagnostic Service ID
    115         S RORSEG(24)="PHY"
    116         ;
    117         ;--- OBR-44 - Division
    118         S RORSEG(44)=$$SITE^RORUTL03(CS)
    119         S TMP=+$P(VST0,U,6)  ; LOC. OF ENCOUNTER (.06)
    120         I TMP>0  D
    121         . S TMP=$$NS^XUAF4(TMP),STN=$P(TMP,U,2)
    122         . S:STN'="" RORSEG(44)=STN_CS_$P(TMP,U)_CS_"99VA4"
    123         ;
    124         ;--- Store the segment
    125         D ADDSEG^RORHL7(.RORSEG)
    126         Q ERRCNT
    127         ;
    128         ;***** OBX SEGMENT BUILDER (OUTPATIENT)
    129         ;
    130         ; RORIEN        IEN of file #9000010
    131         ; RORDFN        DFN of Patient Record in File #2
    132         ;
    133         ; Return Values:
    134         ;       <0  Error Code
    135         ;        0  Ok
    136         ;       >0  Non-fatal error(s)
    137         ;
    138 OBX(RORIEN,RORDFN)      ;
    139         N ERRCNT,RC,RORCS,RORLST,RORMSG,RORSEG,TMP
    140         S (ERRCNT,RC)=0
    141         D ECH^RORHL7(.RORCS)
    142         ;
    143         ;--- Procedures
    144         I $D(^TMP("PXKENC",$J,RORIEN,"CPT"))>1  D  Q:RC<0 RC
    145         . S RC=$$PROCS()  S:RC ERRCNT=ERRCNT+1
    146         ;--- Diagnosis codes
    147         I $D(^TMP("PXKENC",$J,RORIEN,"POV"))>1  D  Q:RC<0 RC
    148         . S RC=$$DIAGS()  S:RC ERRCNT=ERRCNT+1
    149         ;
    150         Q ERRCNT
    151         ;
    152         ;***** PROCESSES PROCEDURES
    153 PROCS() ;
    154         N CLASS,ERRCNT,IEN,K5,OID,PROC,PRV,REC,RORMSG,TMP
    155         S ERRCNT=0
    156         S OID="OCPT"_RORCS_"Procedures"_RORCS_"VA080"
    157         S K5=""
    158         F  S K5=$O(^TMP("PXKENC",$J,RORIEN,"CPT",K5))  Q:K5=""  D
    159         . S REC=$G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,0))
    160         . S IEN=+$P(REC,U)  Q:IEN'>0
    161         . ;---
    162         . S PROC=$$CODEC^ICPTCOD(IEN)
    163         . Q:PROC<0
    164         . ;---
    165         . S PRV=+$P($G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,12)),U,4)
    166         . ;12/06/2007 BAY/KAM REM CALL 218601 Modified next 8 lines
    167         . ;---
    168         . I PRV>0 D
    169         .. S $P(PRV,RORCS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
    170         .. I $G(DIERR)  D  S ERRCNT=ERRCNT+1
    171         ... D DBS^RORERR("RORMSG",-99,,RORDFN,200,+PRV_",")
    172         . E  S PRV=""
    173         . ;----------> End of changes for 218601
    174         . ;---
    175         . D SETOBX(OID,PROC,PRV)
    176         Q ERRCNT
    177         ;
    178         ;***** PV1 SEGMENT BUILDER (OUTPATIENT)
    179         ;
    180         ; RORIEN        IEN in the file #9000010
    181         ; RORDFN        DFN of Patient Record in File #2
    182         ;
    183         ; Return Values:
    184         ;       <0  Error Code
    185         ;        0  Ok
    186         ;      "S"  No visit data
    187         ;       >0  Non-fatal error(s)
    188         ;
    189 PV1(RORIEN,RORDFN)      ;
    190         N BUF,CLASS,CS,ERRCNT,IENS,KK4,RC,REC,REP,RORCLIN,RORMSG,PRV,TMP,TMP1,VST0
    191         S (ERRCNT,RC)=0
    192         D ECH^RORHL7(.CS,,.REP)
    193         ;
    194         ;--- Get Visit Data
    195         D ENCEVENT^PXKENC(RORIEN,1)
    196         Q:$D(^TMP("PXKENC",$J,RORIEN))<10 "S"
    197         S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
    198         ;
    199         ;--- Do not send visits with the following service categories: Daily
    200         ;--- Hospitalization (D), Ancillary (X), Chart (C), Not Found (N),
    201         ;                    (E), Event Historical, Hospitalization (H).
    202         Q:"HEDXNC"[$P(VST0,U,7) "S"
    203         ;
    204         ;--- Initialize the segment
    205         S RORSEG(0)="PV1"
    206         ;
    207         ;--- PV1-2 - Patient Class
    208         S RORSEG(2)="O"  ; O - Outpatient
    209         ;
    210         ;--- PV1-3 - Assigned Patient Location (Station Number and Stop Code)
    211         S RORCLIN=+$P(VST0,U,22),BUF=""
    212         I RORCLIN>0  D
    213         . S IENS=RORCLIN_","
    214         . S TMP=$$GET1^DIQ(44,IENS,3.5,"I")  Q:TMP'>0
    215         . S BUF=$$GET1^DIQ(40.8,TMP,1)       Q:BUF=""  ; Station Number
    216         . S TMP=$$STOPCODE^RORUTL18(+RORCLIN)
    217         . S $P(BUF,CS,6)=$S(TMP>0:TMP,1:"")            ; Stop Code
    218         Q:$P(BUF,CS,6)="" "S"  ; Stop Code is required
    219         S RORSEG(3)=BUF
    220         ;
    221         ; PV1-4  - Admission Type
    222         S TMP=$P($G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,150)),U,3)
    223         S RORSEG(4)=TMP
    224         ;
    225         ;--- PV1-7 - Attending Physician (User IEN and Provider Class Name)
    226         S (KK4,BUF)=""
    227         F  S KK4=$O(^TMP("PXKENC",$J,RORIEN,"PRV",KK4))  Q:KK4=""  D
    228         . S REC=$G(^TMP("PXKENC",$J,RORIEN,"PRV",KK4,0))
    229         . S PRV=+$P(REC,U)  Q:(PRV'>0)!($P(REC,U,4)'="P")
    230         . S $P(PRV,CS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
    231         . I $G(DIERR)  D  S ERRCNT=ERRCNT+1
    232         . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,PRV_",")
    233         . S BUF=BUF_REP_PRV
    234         S RORSEG(7)=$P(BUF,REP,2,999)
    235         ;
    236         ;--- PV1-19 - Visit Number (IEN in the VISIT file #9000010) *KEY*
    237         S RORSEG(19)=RORIEN
    238         ;
    239         ;--- PV1-44 - Admit Date/Time (Visit Date/Time) *KEY*
    240         S TMP=$$FMTHL7^XLFDT($P(VST0,U))
    241         I TMP'>0  D  Q RC
    242         . S RC=$$ERROR^RORERR(-100,,,,"No admission date","ENCEVENT^PXKENC")
    243         S RORSEG(44)=TMP
    244         ;
    245         ;--- PV1-51 - Visit Indicator (Deleted Visit Indicator)
    246         S TMP=$P(VST0,U,11)
    247         S RORSEG(51)=$S(TMP'="":TMP,1:0)
    248         ;
    249         ;--- Store the segment
    250         D ADDSEG^RORHL7(.RORSEG)
    251         Q ERRCNT
    252         ;
    253         ;***** LOW-LEVEL SEGMENT BUILDER
    254         ;
    255         ; OBX3          Observation Identifier
    256         ;
    257         ; OBX5          Observation Value
    258         ;
    259         ; [OBX16]       Procedure Provider and Provider Class Name
    260         ;
    261 SETOBX(OBX3,OBX5,OBX16) ;
    262         N RORSEG
    263         S RORSEG(0)="OBX"
    264         ;--- OBX-2 Value Type
    265         S RORSEG(2)="FT"
    266         ;--- OBX-3 Observation Identifier
    267         S RORSEG(3)=OBX3
    268         ;--- OBX-5 Observation Value
    269         S RORSEG(5)=OBX5
    270         ;--- OBX-11 Observation Result Status
    271         S RORSEG(11)="F"
    272         ;--- OBX-16 Responsible Observer (Procedure Provider)
    273         S:$G(OBX16)'="" RORSEG(16)=OBX16
    274         ;--- Store the segment
    275         D ADDSEG^RORHL7(.RORSEG)
    276         Q
     1RORHL09 ;HOIFO/BH - HL7 OUTPATIENT DATA: PV1,OBR,OBX ; 3/13/06 9:24am
     2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
     3 ;
     4 ; This routine uses the following IAs:
     5 ;
     6 ; #93       Get stop code from the file #44 (controlled)
     7 ; #1889     Use of the ENCEVENT^PXKENC API
     8 ; #1995     $$CODEC^ICPTCOD (supported)
     9 ; #2309     Read access to the 'AA' x-ref in VISIT file (#9000010)
     10 ; #3990     $$CODEC^ICDCODE (supported)
     11 ; #10060    Read access to the file #200 (supported)
     12 ; #2438     Access to the file #40.8 (field #1) (controlled)
     13 ;
     14 Q
     15 ;
     16 ;***** PROCESSES DIAGNOSIS CODES
     17DIAGS() ;
     18 N DIAG,IEN,K5,OID,REC,TMP
     19 S OID="OICD9"_RORCS_"Diagnosis"_RORCS_"VA080"
     20 S K5=""
     21 F  S K5=$O(^TMP("PXKENC",$J,RORIEN,"POV",K5))  Q:K5=""  D
     22 . S REC=^TMP("PXKENC",$J,RORIEN,"POV",K5,0)
     23 . S IEN=+$P(REC,U)  Q:IEN'>0
     24 . ;---
     25 . S DIAG=$$CODEC^ICDCODE(IEN)
     26 . D:DIAG'<0 SETOBX(OID,DIAG)
     27 Q 0
     28 ;
     29 ;***** OUTPATIENT DATA SEGMENT BUILDER
     30 ;
     31 ; RORDFN        DFN of Patient Record in File #2
     32 ;
     33 ; .DXDTS        Reference to a local variable where the
     34 ;               data extraction time frames are stored.
     35 ;
     36 ; RORTY         Set to either "PV1" or "OBR"
     37 ;
     38 ; The ^TMP("PXKENC",$J) and ^TMP("RORHL08",$J) global nodes are
     39 ; used by this function.
     40 ;
     41 ; Return Values:
     42 ;       <0  Error Code
     43 ;        0  Ok
     44 ;       >0  Non-fatal error(s)
     45 ;
     46EN1(RORDFN,DXDTS,RORTY) ;
     47 N ERRCNT,PIEN,PV1CNT,RC
     48 S (ERRCNT,RC)=0
     49 ;
     50 ;--- PV1 Segments
     51 I RORTY="PV1"  K ^TMP("PXKENC",$J),^TMP("RORHL09",$J)  D
     52 . N IDX,INVDT,ROREND
     53 . S (IDX,PV1CNT)=0
     54 . F  S IDX=$O(DXDTS(2,IDX))  Q:IDX'>0  D  Q:RC<0
     55 . . S INVDT=9999999-$$FMADD^XLFDT($P(DXDTS(2,IDX),U)\1,-1)
     56 . . S ROREND=9999999-$P(DXDTS(2,IDX),U,2)
     57 . . F  S INVDT=$O(^AUPNVSIT("AA",RORDFN,INVDT),-1)  Q:'INVDT!(INVDT'>ROREND)  D
     58 . . . S PIEN=""
     59 . . . F  S PIEN=$O(^AUPNVSIT("AA",RORDFN,INVDT,PIEN),-1)  Q:'PIEN  D
     60 . . . . S TMP=$$PV1(PIEN,RORDFN)
     61 . . . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
     62 . . . . ;--- Reference for the corresponding OBR segment
     63 . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL09",$J,PV1CNT)=PIEN
     64 ;
     65 ;--- OBR and OBX Segments
     66 I RORTY="OBR"  D  K ^TMP("PXKENC",$J),^TMP("RORHL09",$J)
     67 . S PV1CNT=0
     68 . F  S PV1CNT=$O(^TMP("RORHL09",$J,PV1CNT))  Q:PV1CNT'>0  D
     69 . . S PIEN=+$G(^TMP("RORHL09",$J,PV1CNT))  Q:PIEN'>0
     70 . . ;---
     71 . . S TMP=$$OBR(PIEN,RORDFN)
     72 . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
     73 . . ;---
     74 . . S TMP=$$OBX(PIEN,RORDFN)
     75 . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
     76 ;
     77 ;--- Check for errors
     78 Q $S(RC<0:RC,1:ERRCNT)
     79 ;
     80 ;***** OBR SEGMENT BUILDER (OUTPATIENT)
     81 ;
     82 ; RORIEN        IEN of file #9000010
     83 ; RORDFN        DFN of Patient Record in File #2
     84 ;
     85 ; Return Values:
     86 ;       <0  Error Code
     87 ;        0  Ok
     88 ;       >0  Non-fatal error(s)
     89 ;
     90OBR(RORIEN,RORDFN) ;
     91 N CS,ERRCNT,RC,RORSEG,STN,TMP,VST0
     92 S (ERRCNT,RC)=0
     93 D ECH^RORHL7(.CS)
     94 ;
     95 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
     96 ;
     97 ;--- Initialize the segment
     98 S RORSEG(0)="OBR"
     99 ;
     100 ;--- OBR-3 - Order Number (IEN in the VISIT file #9000010)
     101 S RORSEG(3)=RORIEN
     102 ;
     103 ;--- OBR-4 - Universal Service ID
     104 S RORSEG(4)="OP"_CS_"Outpatient"_CS_"C4"
     105 ;
     106 ;--- OBR-7 - Observation Date/Time (Visit Date/Time) *KEY*
     107 S TMP=$$FMTHL7^XLFDT($P(VST0,U))
     108 Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No visit date","ENCEVENT^PXKENC")
     109 S RORSEG(7)=TMP
     110 ;
     111 ;--- OBR-24 - Diagnostic Service ID
     112 S RORSEG(24)="PHY"
     113 ;
     114 ;--- OBR-44 - Division
     115 S RORSEG(44)=$$SITE^RORUTL03(CS)
     116 S TMP=+$P(VST0,U,6)  ; LOC. OF ENCOUNTER (.06)
     117 I TMP>0  D
     118 . S TMP=$$NS^XUAF4(TMP),STN=$P(TMP,U,2)
     119 . S:STN'="" RORSEG(44)=STN_CS_$P(TMP,U)_CS_"99VA4"
     120 ;
     121 ;--- Store the segment
     122 D ADDSEG^RORHL7(.RORSEG)
     123 Q ERRCNT
     124 ;
     125 ;***** OBX SEGMENT BUILDER (OUTPATIENT)
     126 ;
     127 ; RORIEN        IEN of file #9000010
     128 ; RORDFN        DFN of Patient Record in File #2
     129 ;
     130 ; Return Values:
     131 ;       <0  Error Code
     132 ;        0  Ok
     133 ;       >0  Non-fatal error(s)
     134 ;
     135OBX(RORIEN,RORDFN) ;
     136 N ERRCNT,RC,RORCS,RORLST,RORMSG,RORSEG,TMP
     137 S (ERRCNT,RC)=0
     138 D ECH^RORHL7(.RORCS)
     139 ;
     140 ;--- Procedures
     141 I $D(^TMP("PXKENC",$J,RORIEN,"CPT"))>1  D  Q:RC<0 RC
     142 . S RC=$$PROCS()  S:RC ERRCNT=ERRCNT+1
     143 ;--- Diagnosis codes
     144 I $D(^TMP("PXKENC",$J,RORIEN,"POV"))>1  D  Q:RC<0 RC
     145 . S RC=$$DIAGS()  S:RC ERRCNT=ERRCNT+1
     146 ;
     147 Q ERRCNT
     148 ;
     149 ;***** PROCESSES PROCEDURES
     150PROCS() ;
     151 N CLASS,ERRCNT,IEN,K5,OID,PROC,PRV,REC,RORMSG,TMP
     152 S ERRCNT=0
     153 S OID="OCPT"_RORCS_"Procedures"_RORCS_"VA080"
     154 S K5=""
     155 F  S K5=$O(^TMP("PXKENC",$J,RORIEN,"CPT",K5))  Q:K5=""  D
     156 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,0))
     157 . S IEN=+$P(REC,U)  Q:IEN'>0
     158 . ;---
     159 . S PROC=$$CODEC^ICPTCOD(IEN)
     160 . Q:PROC<0
     161 . ;---
     162 . S PRV=+$P($G(^TMP("PXKENC",$J,RORIEN,"CPT",K5,12)),U,4)
     163 . Q:PRV'>0
     164 . ;---
     165 . S $P(PRV,RORCS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
     166 . I $G(DIERR)  D  S ERRCNT=ERRCNT+1
     167 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,+PRV_",")
     168 . ;---
     169 . D SETOBX(OID,PROC,PRV)
     170 Q ERRCNT
     171 ;
     172 ;***** PV1 SEGMENT BUILDER (OUTPATIENT)
     173 ;
     174 ; RORIEN        IEN in the file #9000010
     175 ; RORDFN        DFN of Patient Record in File #2
     176 ;
     177 ; Return Values:
     178 ;       <0  Error Code
     179 ;        0  Ok
     180 ;      "S"  No visit data
     181 ;       >0  Non-fatal error(s)
     182 ;
     183PV1(RORIEN,RORDFN) ;
     184 N BUF,CLASS,CS,ERRCNT,IENS,KK4,RC,REC,REP,RORCLIN,RORMSG,PRV,TMP,TMP1,VST0
     185 S (ERRCNT,RC)=0
     186 D ECH^RORHL7(.CS,,.REP)
     187 ;
     188 ;--- Get Visit Data
     189 D ENCEVENT^PXKENC(RORIEN,1)
     190 Q:$D(^TMP("PXKENC",$J,RORIEN))<10 "S"
     191 S VST0=$G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,0))
     192 ;
     193 ;--- Do not send visits with the following service categories: Daily
     194 ;--- Hospitalization (D), Ancillary (X), Chart (C), Not Found (N),
     195 ;                    (E), Event Historical, Hospitalization (H).
     196 Q:"HEDXNC"[$P(VST0,U,7) "S"
     197 ;
     198 ;--- Initialize the segment
     199 S RORSEG(0)="PV1"
     200 ;
     201 ;--- PV1-2 - Patient Class
     202 S RORSEG(2)="O"  ; O - Outpatient
     203 ;
     204 ;--- PV1-3 - Assigned Patient Location (Station Number and Stop Code)
     205 S RORCLIN=+$P(VST0,U,22),BUF=""
     206 I RORCLIN>0  D
     207 . S IENS=RORCLIN_","
     208 . S TMP=$$GET1^DIQ(44,IENS,3.5,"I")  Q:TMP'>0
     209 . S BUF=$$GET1^DIQ(40.8,TMP,1)       Q:BUF=""  ; Station Number
     210 . S TMP=$$STOPCODE^RORUTL18(+RORCLIN)
     211 . S $P(BUF,CS,6)=$S(TMP>0:TMP,1:"")            ; Stop Code
     212 Q:$P(BUF,CS,6)="" "S"  ; Stop Code is required
     213 S RORSEG(3)=BUF
     214 ;
     215 ; PV1-4  - Admission Type
     216 S TMP=$P($G(^TMP("PXKENC",$J,RORIEN,"VST",RORIEN,150)),U,3)
     217 S RORSEG(4)=TMP
     218 ;
     219 ;--- PV1-7 - Attending Physician (User IEN and Provider Class Name)
     220 S (KK4,BUF)=""
     221 F  S KK4=$O(^TMP("PXKENC",$J,RORIEN,"PRV",KK4))  Q:KK4=""  D
     222 . S REC=$G(^TMP("PXKENC",$J,RORIEN,"PRV",KK4,0))
     223 . S PRV=+$P(REC,U)  Q:(PRV'>0)!($P(REC,U,4)'="P")
     224 . S $P(PRV,CS,13)=$$GET1^DIQ(200,PRV_",",53.5,"E",,"RORMSG")
     225 . I $G(DIERR)  D  S ERRCNT=ERRCNT+1
     226 . . D DBS^RORERR("RORMSG",-99,,RORDFN,200,PRV_",")
     227 . S BUF=BUF_REP_PRV
     228 S RORSEG(7)=$P(BUF,REP,2,999)
     229 ;
     230 ;--- PV1-19 - Visit Number (IEN in the VISIT file #9000010) *KEY*
     231 S RORSEG(19)=RORIEN
     232 ;
     233 ;--- PV1-44 - Admit Date/Time (Visit Date/Time) *KEY*
     234 S TMP=$$FMTHL7^XLFDT($P(VST0,U))
     235 I TMP'>0  D  Q RC
     236 . S RC=$$ERROR^RORERR(-100,,,,"No admission date","ENCEVENT^PXKENC")
     237 S RORSEG(44)=TMP
     238 ;
     239 ;--- PV1-51 - Visit Indicator (Deleted Visit Indicator)
     240 S TMP=$P(VST0,U,11)
     241 S RORSEG(51)=$S(TMP'="":TMP,1:0)
     242 ;
     243 ;--- Store the segment
     244 D ADDSEG^RORHL7(.RORSEG)
     245 Q ERRCNT
     246 ;
     247 ;***** LOW-LEVEL SEGMENT BUILDER
     248 ;
     249 ; OBX3          Observation Identifier
     250 ;
     251 ; OBX5          Observation Value
     252 ;
     253 ; [OBX16]       Procedure Provider and Provider Class Name
     254 ;
     255SETOBX(OBX3,OBX5,OBX16) ;
     256 N RORSEG
     257 S RORSEG(0)="OBX"
     258 ;--- OBX-2 Value Type
     259 S RORSEG(2)="FT"
     260 ;--- OBX-3 Observation Identifier
     261 S RORSEG(3)=OBX3
     262 ;--- OBX-5 Observation Value
     263 S RORSEG(5)=OBX5
     264 ;--- OBX-11 Observation Result Status
     265 S RORSEG(11)="F"
     266 ;--- OBX-16 Responsible Observer (Procedure Provider)
     267 S:$G(OBX16)'="" RORSEG(16)=OBX16
     268 ;--- Store the segment
     269 D ADDSEG^RORHL7(.RORSEG)
     270 Q
Note: See TracChangeset for help on using the changeset viewer.