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/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABUL3.m

    r613 r623  
    1 RABUL3  ;HISC/FPT,GJC-'RAD/NUC MED REPORT DELETION' Bulletin ;3/21/95  13:56
    2         ;;5.0;Radiology/Nuclear Medicine;**56**;Mar 16, 1998;Build 3
    3         ;Supported IA #10035 ^DPT(
    4         ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    5         ; The variables DA must be defined.  The value of DA must be greater
    6         ; than 0.  These conditions must exist for the RAD/NUC MED REPORT
    7         ; DELETION bulletin to execute.
    8         ; Called from:
    9         ;   ^DD(74,.01,1,2,0-"DT") xref nodes if deletion via Fileman
    10         ;   routine RARTE7, if deletion via Rad pkg (RA*5*56)
    11         ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    12         ;                     ***** Variable List *****
    13         ; 'DIFQ'     -> Variable used to check if we are installing the
    14         ;               Radiology Package.  If we are, do not fire off
    15         ;               bulletins.
    16         ; 'RADFN'    -> IEN of the patient in the PATIENT file (2)
    17         ; 'RAEXAM'   -> IEN of a record in the Examinations multiple
    18         ;               of the Radiology/Nuclear Medicine Patient file. (70)
    19         ; 'RAEXAM(0)'-> Zero node of a record in the Examinations multiple
    20         ;               of the Radiology/Nuclear Medicine Patient file. (70)
    21         ; 'RARXAM(0)'-> Zero node of a record in the Registered Exam multiple
    22         ;               of the Radiology/Nuclear Medicine Patient file. (70)
    23         ; 'RAFN1'    -> internal format of a FM date/time data element
    24         ;               { internal format pointer value }
    25         ; 'RAFN2'    -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
    26         ; 'A'        -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE REPORTS
    27         ;               file (74) { node: ^RARPT(DA,0) }
    28         ;
    29         ; Format: Data to be fired;local var name;XMB array representation
    30         ; Patient ; RANAME ; XMB(1)     <---> Exam Date ; RAXDT ; XMB(4)
    31         ; Patient SSN ; RASSN ; XMB(2)  <---> Desired Date ; RADDT ; XMB(5)
    32         ; Case Number ; RACASE ; XMB(3) <---> Report Status ; RASTAT ; XMB(6)
    33         ; Imaging Loc ; RAILOC ; XMB(7)
    34         ;
    35 EN1     Q:$D(DIFQ)!(+$G(DA)'>0)  ; Quit if installing software or invalid IEN
    36         N A,RACASE,RACN,RADDT,RADTI,RADFN,RAEXAM,RAFN1,RAFN2,RAILOC,RANAME
    37         N RARXAM,RASSN,RASTAT,RAXDT,X,Y
    38         S A=$G(^RARPT(DA,0))
    39         S Y=DA D RASET^RAUTL2 ; Derive case/exam data from file 70
    40         S RADFN(0)=RADFN
    41         S (RADFN,RANAME)=+$P(A,U,2)
    42         S RANAME=$S($D(^DPT(RANAME,0)):$P(^(0),U),1:"Unknown")
    43         S RASSN=$$SSN^RAUTL() S RADFN=RADFN(0)
    44         S RACASE=$S($P(A,U)]"":$P(A,U),1:"Unknown")
    45         S RAFN1=$P(A,U,3),RAFN2=$P($G(^DD(74,3,0)),U,2)
    46         S RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
    47         S RAXDT=$S(RAXDT]"":RAXDT,1:"Unknown")
    48         S RARXAM(0)=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),0))
    49         S RAEXAM=$O(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P","B",+$G(RACN),0))
    50         S RAEXAM(0)=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RAEXAM),0))
    51         S RAFN1=$P(RAEXAM(0),U,21),RAFN2=$P($G(^DD(70.03,21,0)),U,2)
    52         S RADDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
    53         S RADDT=$S(RADDT]"":RADDT,1:"Unknown")
    54         S RAFN1=$S($D(RACLOAK)#2:RACLOAK,1:$P(A,U,5)),RAFN2=$P($G(^DD(74,5,0)),U,2)
    55         S RASTAT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
    56         S RASTAT=$S(RASTAT]"":RASTAT,1:"Unknown")
    57         S RAFN1=$P(RARXAM(0),U,4),RAFN2=$P($G(^DD(70.02,4,0)),U,2)
    58         S RAILOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
    59         S RAILOC=$S(RAILOC]"":RAILOC,1:"Unknown")
    60         S XMB(1)=RANAME,XMB(2)=RASSN,XMB(3)=RACASE
    61         S XMB(4)=RAXDT,XMB(5)=RADDT,XMB(6)=RASTAT
    62         S XMB(7)=RAILOC,XMB="RAD/NUC MED REPORT DELETION"
    63         D ^XMB:$D(^XMB(3.6,"B",XMB))
    64         K XMB,XMB0,XMC0,XMDT,XMM,XMMG
    65         Q
    66 CLOAK   ;called from RARTE7 right after report is deleted but cloaked
    67         Q:'$D(RAIEN)#2  ;report ien
    68         Q:'$D(RAIEN2)#2  ;activity log sub ien
    69         S DA=RAIEN
    70         S RACLOAK=$P(^RARPT(DA,"L",RAIEN2,0),U,4) ;previous rpt status
    71         G EN1
     1RABUL3 ;HISC/FPT,GJC-'RAD/NUC MED REPORT DELETION' Bulletin ;3/21/95  13:56
     2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
     3 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     4 ; The variables DA must be defined.  The value of DA must be greater
     5 ; than 0.  These conditions must exist for the RAD/NUC MED REPORT
     6 ; DELETION bulletin to execute.
     7 ; Called from: ^DD(74,.01,1,2,0-"DT") xref nodes
     8 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     9 ;                     ***** Variable List *****
     10 ; 'DIFQ'     -> Variable used to check if we are installing the
     11 ;               Radiology Package.  If we are, do not fire off
     12 ;               bulletins.
     13 ; 'RADFN'    -> IEN of the patient in the PATIENT file (2)
     14 ; 'RAEXAM'   -> IEN of a record in the Examinations multiple
     15 ;               of the Radiology/Nuclear Medicine Patient file. (70)
     16 ; 'RAEXAM(0)'-> Zero node of a record in the Examinations multiple
     17 ;               of the Radiology/Nuclear Medicine Patient file. (70)
     18 ; 'RARXAM(0)'-> Zero node of a record in the Registered Exam multiple
     19 ;               of the Radiology/Nuclear Medicine Patient file. (70)
     20 ; 'RAFN1'    -> internal format of a FM date/time data element
     21 ;               { internal format pointer value }
     22 ; 'RAFN2'    -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
     23 ; 'A'        -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE REPORTS
     24 ;               file (74) { node: ^RARPT(DA,0) }
     25 ;
     26 ; Format: Data to be fired;local var name;XMB array representation
     27 ; Patient ; RANAME ; XMB(1)     <---> Exam Date ; RAXDT ; XMB(4)
     28 ; Patient SSN ; RASSN ; XMB(2)  <---> Desired Date ; RADDT ; XMB(5)
     29 ; Case Number ; RACASE ; XMB(3) <---> Report Status ; RASTAT ; XMB(6)
     30 ; Imaging Loc ; RAILOC ; XMB(7)
     31 ;
     32 Q:$D(DIFQ)!(+$G(DA)'>0)  ; Quit if installing software or invalid IEN
     33 N A,RACASE,RACN,RADDT,RADTI,RADFN,RAEXAM,RAFN1,RAFN2,RAILOC,RANAME
     34 N RARXAM,RASSN,RASTAT,RAXDT,X,Y
     35 S A=$G(^RARPT(DA,0))
     36 S Y=DA D RASET^RAUTL2 ; Derive case/exam data from file 70
     37 S RADFN(0)=RADFN
     38 S (RADFN,RANAME)=+$P(A,U,2)
     39 S RANAME=$S($D(^DPT(RANAME,0)):$P(^(0),U),1:"Unknown")
     40 S RASSN=$$SSN^RAUTL() S RADFN=RADFN(0)
     41 S RACASE=$S($P(A,U)]"":$P(A,U),1:"Unknown")
     42 S RAFN1=$P(A,U,3),RAFN2=$P($G(^DD(74,3,0)),U,2)
     43 S RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
     44 S RAXDT=$S(RAXDT]"":RAXDT,1:"Unknown")
     45 S RARXAM(0)=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),0))
     46 S RAEXAM=$O(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P","B",+$G(RACN),0))
     47 S RAEXAM(0)=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RAEXAM),0))
     48 S RAFN1=$P(RAEXAM(0),U,21),RAFN2=$P($G(^DD(70.03,21,0)),U,2)
     49 S RADDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
     50 S RADDT=$S(RADDT]"":RADDT,1:"Unknown")
     51 S RAFN1=$P(A,U,5),RAFN2=$P($G(^DD(74,5,0)),U,2)
     52 S RASTAT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
     53 S RASTAT=$S(RASTAT]"":RASTAT,1:"Unknown")
     54 S RAFN1=$P(RARXAM(0),U,4),RAFN2=$P($G(^DD(70.02,4,0)),U,2)
     55 S RAILOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
     56 S RAILOC=$S(RAILOC]"":RAILOC,1:"Unknown")
     57 S XMB(1)=RANAME,XMB(2)=RASSN,XMB(3)=RACASE
     58 S XMB(4)=RAXDT,XMB(5)=RADDT,XMB(6)=RASTAT
     59 S XMB(7)=RAILOC,XMB="RAD/NUC MED REPORT DELETION"
     60 D ^XMB:$D(^XMB(3.6,"B",XMB))
     61 K XMB,XMB0,XMC0,XMDT,XMM,XMMG
     62 Q
Note: See TracChangeset for help on using the changeset viewer.