RABUL1.m

RABUL1 ;HISC/FPT,GJC-'RAD/NUC MED EXAM DELETED' Bulletin ;10/24/94  15:22

 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 ; The DA array and RABULL must be defined.

 ; The elements of the DA array must be greater than 0, and RABULL must

 ; exist for the RAD/NUC MED EXAM DELETED bulletin to execute.

 ; Note: This routine is closely related to the code at: ASKDEL^RAEDCN

 ; Called from: ^DD(70.03,.01,1,2,0-"DT") xref nodes

 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 ;                     ***** Variable List *****

 ; 'DIFQ'   -> Variable used check if we are installing the Radiology

 ;             Package.  If we are, do not fire the bulletins.

 ; 'RABULL' -> Flag to send bulletin, defined in ASKDEL^RAEDCN

 ; 'RADFN'  -> IEN of the patient in the PATIENT file (2)

 ; 'RAFN1'  -> internal format of a FM date/time data element

 ;             { internal format pointer value }

 ; 'RAFN2'  -> FM data definition for RAFN1, used in XTERNAL^RAUTL5

 ; 'A'      -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT

 ;             file (70) { node: ^RADPT(DA(2),"DT",DA(1),"P",DA,0) }

 ; 'B'      -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT

 ;             file (70) { node: ^RADPT(DA(2),"DT",DA(1),0) }

 ; 'C'      -> Zero node of the RADIOLOGY PATIENT/NUCLEAR MEDICINE

 ;             file (70) { node: ^RADPT(DA(2),0) }

 ;

 ; Format: Data to be fired;local var name;XMB array representation

 ; Patient ; RANAME ; XMB(1)     <---> Req. Date ; RARDT ; XMB(5)

 ; Patient SSN ; RASSN ; XMB(2)  <---> Rad. Location ; RARLOC ; XMB(6)

 ; Case Number ; RACASE ; XMB(3) <---> Rad. Procedure ; RARPROC ; XMB(7)

 ; Exam Date ; RAXDT ; XMB(4)

 ;

 Q:$D(DIFQ)  ; Quit if installing the software

 Q:'$D(RABULL)!(+$G(DA(2))'>0)!(+$G(DA(1))'>0)!(+$G(DA)'>0)

 N A,B,C,RACASE,RADFN,RAFN1,RAFN2,RANAME,RARDT,RARLOC,RARPROC,RASSN

 N RAXDT,X,Y

 S A=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0))

 S B=$G(^RADPT(DA(2),"DT",DA(1),0))

 S C=$G(^RADPT(DA(2),0))

 S (RADFN,RANAME)=+$P(C,U)

 S RANAME=$S($D(^DPT(RANAME,0)):$P(^(0),U),1:"Unknown")

 S RASSN=$$SSN^RAUTL()

 S RACASE=$S($P(A,U)]"":$P(A,U),1:"Unknown")

 S RAFN1=$P(B,U),RAFN2=$P($G(^DD(70.02,.01,0)),U,2)

 S RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 S RAXDT=$S(RAXDT]"":RAXDT,1:"Unknown")

 S RAFN1=$P(A,U,21),RAFN2=$P($G(^DD(70.03,21,0)),U,2)

 S RARDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 S RARDT=$S(RARDT]"":RARDT,1:"Unknown")

 S RAFN1=$P(B,U,4),RAFN2=$P($G(^DD(70.02,4,0)),U,2)

 S RARLOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 S RARLOC=$S(RARLOC]"":RARLOC,1:"Unknown")

 S RAFN1=$P(A,U,2),RAFN2=$P($G(^DD(70.03,2,0)),U,2)

 S RARPROC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 S RARPROC=$S(RARPROC]"":RARPROC,1:"Unknown")

 S XMB(1)=RANAME,XMB(2)=RASSN,XMB(3)=RACASE,XMB(4)=RAXDT

 S XMB(5)=RARDT,XMB(6)=RARLOC,XMB(7)=RARPROC

 S XMB="RAD/NUC MED EXAM DELETED"

 D ^XMB:$D(^XMB(3.6,"B",XMB))

 K XMB,XMB0,XMC0,XMDT,XMM,XMMG

 Q

RABUL1    ;HISC/FPT,GJC-'RAD/NUC MED EXAM DELETED' Bulletin ;10/24/94  15:22

 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

 +2       ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 +3       ; The DA array and RABULL must be defined.

 +4       ; The elements of the DA array must be greater than 0, and RABULL must

 +5       ; exist for the RAD/NUC MED EXAM DELETED bulletin to execute.

 +6       ; Note: This routine is closely related to the code at: ASKDEL^RAEDCN

 +7       ; Called from: ^DD(70.03,.01,1,2,0-"DT") xref nodes

 +8       ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 +9       ;                     ***** Variable List *****

 +10      ; 'DIFQ'   -> Variable used check if we are installing the Radiology

 +11      ;             Package.  If we are, do not fire the bulletins.

 +12      ; 'RABULL' -> Flag to send bulletin, defined in ASKDEL^RAEDCN

 +13      ; 'RADFN'  -> IEN of the patient in the PATIENT file (2)

 +14      ; 'RAFN1'  -> internal format of a FM date/time data element

 +15      ;             { internal format pointer value }

 +16      ; 'RAFN2'  -> FM data definition for RAFN1, used in XTERNAL^RAUTL5

 +17      ; 'A'      -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT

 +18      ;             file (70) { node: ^RADPT(DA(2),"DT",DA(1),"P",DA,0) }

 +19      ; 'B'      -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT

 +20      ;             file (70) { node: ^RADPT(DA(2),"DT",DA(1),0) }

 +21      ; 'C'      -> Zero node of the RADIOLOGY PATIENT/NUCLEAR MEDICINE

 +22      ;             file (70) { node: ^RADPT(DA(2),0) }

 +23      ;

 +24      ; Format: Data to be fired;local var name;XMB array representation

 +25      ; Patient ; RANAME ; XMB(1)     <---> Req. Date ; RARDT ; XMB(5)

 +26      ; Patient SSN ; RASSN ; XMB(2)  <---> Rad. Location ; RARLOC ; XMB(6)

 +27      ; Case Number ; RACASE ; XMB(3) <---> Rad. Procedure ; RARPROC ; XMB(7)

 +28      ; Exam Date ; RAXDT ; XMB(4)

 +29      ;

 +30      ; Quit if installing the software

           IF $DATA(DIFQ)

               QUIT 

 +31       IF '$DATA(RABULL)!(+$GET(DA(2))'>0)!(+$GET(DA(1))'>0)!(+$GET(DA)'>0)

               QUIT 

 +32       NEW A,B,C,RACASE,RADFN,RAFN1,RAFN2,RANAME,RARDT,RARLOC,RARPROC,RASSN

 +33       NEW RAXDT,X,Y

 +34       SET A=$GET(^RADPT(DA(2),"DT",DA(1),"P",DA,0))

 +35       SET B=$GET(^RADPT(DA(2),"DT",DA(1),0))

 +36       SET C=$GET(^RADPT(DA(2),0))

 +37       SET (RADFN,RANAME)=+$PIECE(C,U)

 +38       SET RANAME=$SELECT($DATA(^DPT(RANAME,0)):$PIECE(^(0),U),1:"Unknown")

 +39       SET RASSN=$$SSN^RAUTL()

 +40       SET RACASE=$SELECT($PIECE(A,U)]"":$PIECE(A,U),1:"Unknown")

 +41       SET RAFN1=$PIECE(B,U)

           SET RAFN2=$PIECE($GET(^DD(70.02,.01,0)),U,2)

 +42       SET RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 +43       SET RAXDT=$SELECT(RAXDT]"":RAXDT,1:"Unknown")

 +44       SET RAFN1=$PIECE(A,U,21)

           SET RAFN2=$PIECE($GET(^DD(70.03,21,0)),U,2)

 +45       SET RARDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 +46       SET RARDT=$SELECT(RARDT]"":RARDT,1:"Unknown")

 +47       SET RAFN1=$PIECE(B,U,4)

           SET RAFN2=$PIECE($GET(^DD(70.02,4,0)),U,2)

 +48       SET RARLOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 +49       SET RARLOC=$SELECT(RARLOC]"":RARLOC,1:"Unknown")

 +50       SET RAFN1=$PIECE(A,U,2)

           SET RAFN2=$PIECE($GET(^DD(70.03,2,0)),U,2)

 +51       SET RARPROC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)

 +52       SET RARPROC=$SELECT(RARPROC]"":RARPROC,1:"Unknown")

 +53       SET XMB(1)=RANAME

           SET XMB(2)=RASSN

           SET XMB(3)=RACASE

           SET XMB(4)=RAXDT

 +54       SET XMB(5)=RARDT

           SET XMB(6)=RARLOC

           SET XMB(7)=RARPROC

 +55       SET XMB="RAD/NUC MED EXAM DELETED"

 +56       IF $DATA(^XMB(3.6,"B",XMB))

               DO ^XMB

 +57       KILL XMB,XMB0,XMC0,XMDT,XMM,XMMG

 +58       QUIT