Ignore:
Timestamp:
Oct 30, 2012, 1:11:02 PM (12 years ago)
Author:
Sam Habiel
Message:

Changed license to AGPL. Some clean-up for XINDEX

File:
1 edited

Legend:

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

    r1544 r1586  
    11C0CRAHL7        ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010
    2                ;;1.2;C0C;;May 11, 2012;Build 47
    3                ;;
    4                Q
    5                ;LENGTH OF SEGMENTS COMPROMISED
    6 GHL7       ; Loop through ^RADPT with RADFN
    7                ; Get Case Number and Reprot Information
    8                ; Extract RAD Report as HL7 Message
    9                ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
    10                ;
    11                D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
    12                D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
    13                S C0CCNT=0
    14                F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
    15                . S C0CRAIDT=0
    16                . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
    17                . . S C0CRANO=0
    18                . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
    19                . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
    20                . . . Q:C0CRAXAM(0)=""
    21                . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
    22                . . . Q:RARPT=""!(RARPT=0)
    23                . . . ;Quit if no report information present
    24                . . . D SETHL7
    25                . . . S C0CSBCNT=0
    26                . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
    27                . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
    28                . . . . S C0CCNT=C0CCNT+1
    29                ;
    30                K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
    31                K C0CRAXAM,C0CCNT,C0CRAEDT
    32                Q
    33                ;
    34 SETHL7   ;SETHL7 SEGMENTS
    35                N RASET,RACN0
    36                S RASET=0
    37                S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
    38                I +$P(RACN0,U,25)=2 D  Q  ; printset
    39                . ; loop through all cases in set and create message
    40                . S RASET=1
    41                . N RACNI,RAII S RAII=0
    42                . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
    43                . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
    44                . . S RACNI=RAII
    45                . . D NEW
    46 NEW         ; new variables
    47                ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
    48                N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN
    49                N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
    50                S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
    51                S (HLECH,HL("ECH"))="^~\&"
    52                S (HLFS,HL("FS"))="|"
    53                S (HLQ,HL("Q"))=""""
    54                S DFN=RADFN D DEM^VADPT
    55                I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
    56                S RAN=0
    57                S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
    58                D SETUP,PID,OBR,OBXRPT
    59 EXIT       ;EXIT FROM NEW
    60                K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
    61                Q
    62                ;
    63 OBR         ;Compile 'OBR' Segment
    64                        S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
    65                S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
    66                ; Replace above with following when Imaging can cope with ESC chars
    67                ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP"
    68                ; Have to use LOCAL code if Broad Procedure - no CPT code
    69                I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL"
    70                S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS
    71                S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
    72                S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
    73                S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown")
    74                ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
    75                N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
    76                S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
    77                S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^")
    78                S $P(X1,HLFS,21)=$P(X1,HLFS,21)
    79                ; Replace above with following when Imaging can cope with ESC chars
    80                ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
    81                ;
    82                S OBR36=9999999.9999-RADTI
    83                S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
    84                ;
    85                S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
    86                S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
    87                ;Principal Result Interpreter = Verifying Physician
    88                S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
    89                .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
    90                .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
    91                .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
    92                ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
    93                S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
    94                .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
    95                .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
    96                .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
    97                I $P(RACN0,"^",12) D
    98                .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
    99                .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
    100                .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
    101                ;Technician = Technologist
    102                S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
    103                .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
    104                .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
    105                .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
    106                .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
    107                .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
    108                ;Transcriptionist
    109                S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
    110                .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
    111                .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
    112                .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
    113                ;
    114                S RAN=RAN+1
    115                I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q
    116                S HLA("HLS",RAN)=X1
    117                Q
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; (C) ELN 2010.
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (at your option) any later version.
     10        ;
     11        ; This program is distributed in the hope that it will be useful,
     12        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     13        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14        ; GNU Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     18        ;
     19        ;
     20        Q
     21        ;LENGTH OF SEGMENTS COMPROMISED
     22GHL7    ; Loop through ^RADPT with RADFN
     23        ; Get Case Number and Reprot Information
     24        ; Extract RAD Report as HL7 Message
     25        ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
     26        ;
     27        D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
     28        D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
     29        S C0CCNT=0
     30        F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
     31        . S C0CRAIDT=0
     32        . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
     33        . . S C0CRANO=0
     34        . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
     35        . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
     36        . . . Q:C0CRAXAM(0)=""
     37        . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
     38        . . . Q:RARPT=""!(RARPT=0)
     39        . . . ;Quit if no report information present
     40        . . . D SETHL7
     41        . . . S C0CSBCNT=0
     42        . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
     43        . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
     44        . . . . S C0CCNT=C0CCNT+1
     45        ;
     46        K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
     47        K C0CRAXAM,C0CCNT,C0CRAEDT
     48        Q
     49        ;
     50SETHL7  ;SETHL7 SEGMENTS
     51        N RASET,RACN0
     52        S RASET=0
     53        S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
     54        I +$P(RACN0,U,25)=2 D  Q  ; printset
     55        . ; loop through all cases in set and create message
     56        . S RASET=1
     57        . N RACNI,RAII S RAII=0
     58        . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
     59        . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
     60        . . S RACNI=RAII
     61        . . D NEW
     62NEW     ; new variables
     63        ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
     64        N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN
     65        N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
     66        S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
     67        S (HLECH,HL("ECH"))="^~\&"
     68        S (HLFS,HL("FS"))="|"
     69        S (HLQ,HL("Q"))=""""
     70        S DFN=RADFN D DEM^VADPT
     71        I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
     72        S RAN=0
     73        S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
     74        D SETUP,PID,OBR,OBXRPT
     75EXIT    ;EXIT FROM NEW
     76        K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
     77        Q
     78        ;
     79OBR     ;Compile 'OBR' Segment
     80        S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
     81        S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
     82        ; Replace above with following when Imaging can cope with ESC chars
     83        ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP"
     84        ; Have to use LOCAL code if Broad Procedure - no CPT code
     85        I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL"
     86        S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS
     87        S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
     88        S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
     89        S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown")
     90        ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
     91        N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
     92        S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
     93        S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^")
     94        S $P(X1,HLFS,21)=$P(X1,HLFS,21)
     95        ; Replace above with following when Imaging can cope with ESC chars
     96        ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
     97        ;
     98        S OBR36=9999999.9999-RADTI
     99        S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
     100        ;
     101        S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
     102        S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
     103        ;Principal Result Interpreter = Verifying Physician
     104        S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
     105        .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
     106        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
     107        .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
     108        ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
     109        S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
     110        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
     111        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
     112        .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
     113        I $P(RACN0,"^",12) D
     114        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
     115        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
     116        .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
     117        ;Technician = Technologist
     118        S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
     119        .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
     120        .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
     121        .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
     122        .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
     123        .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
     124        ;Transcriptionist
     125        S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
     126        .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
     127        .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
     128        .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
     129        ;
     130        S RAN=RAN+1
     131        I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q
     132        S HLA("HLS",RAN)=X1
     133        Q
    118134OBXRPT   ;Compile 'OBX' Segment for Radiology Report Text
    119                N RATX
    120                I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q
    121                S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
    122                S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
    123                Q
    124 PID         ;Compile 'PID' Segment
    125                ;
    126                S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS
    127                S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"))  S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
    128                Q
    129 SETUP     ; Setup basic examination information
    130                S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
    131                S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
    132                S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
    133                S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
    134                S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
    135                S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
    136                Q
     135        N RATX
     136        I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q
     137        S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
     138        S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
     139        Q
     140PID     ;Compile 'PID' Segment
     141        ;
     142        S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS
     143        S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"))  S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
     144        Q
     145SETUP   ; Setup basic examination information
     146        S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
     147        S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
     148        S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
     149        S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
     150        S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
     151        S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
     152        Q
Note: See TracChangeset for help on using the changeset viewer.