BRAPRAD ;CIA/PLS,IHS/ITSC/CLS - Radiology Protocol Event API ; 28 Apr 2014 4:26 PM
;;5.0;Radiology/Nuclear Medicine;**1001,1003,1006**;Nov 01, 2010;Build 2
;
HOOK ;
;S $ZE="RAD PCC TEST" D ^ZTER ;IHS/ITSC/CLS testing
N SEG,LP,DL1,DL2,RAPCC,ACTION,ORDSTS
; Get SEND PCC AT EXAMINED field
S RAPCC=+$G(^RA(79,+$G(RAMDIV),9999999))
S LP=0
S SEG=$$SEG("MSH",.LP)
Q:'LP
S DL1=$E(SEG,4),DL2=$E(SEG,5)
Q:$P(SEG,DL1,3)'="RADIOLOGY"
S SEG=$$SEG("ORC",.LP)
Q:'LP
S ORDSTS=$P(SEG,DL1,6) ; Order Status
S ACTION=$P(SEG,DL1,2) ; Order Control
I ACTION?2U,$L($T(@ACTION)) D @ACTION
Q
;
;
; Return specified segment, starting at line LP
SEG(TYP,LP) ;
F S LP=$O(RAMSG(LP)) Q:'LP Q:$E(RAMSG(LP),1,$L(TYP))=TYP
Q $S(LP:RAMSG(LP),1:"")
;
;
SN ; New Order (doesn't create visit - "PCC" node absent)
Q
;
;
SC ; Status Change (scheduled, registered, or unverified)
; Status Change (registered - ORSTS="ZR", ACTION="SC")
; Status Change (examined - ORSTS="", ACTION="SC")
; Status Change (unverified - ORSTS=ZU, ACTION="SC")
;
;Released report was unverified
I ORDSTS="ZU" D
.D UPDTIMP^BRAPCC($G(RADFN),$G(RADTI))
.D UPDATE^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
;
;
;Don't create visit for registered
;Do create visit if examined and 'Send PCC at Examined' is YES
I ORDSTS="" D
.I RAPCC D
..D CREATE^BRAPCC
..D CREATE^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
Q
;
;
OH ; Exam on Hold, not even registered yet so no action necessary
Q
;
;
OD ; Delete Exam and request
I RAPCC D
.D DELETE^BRAPCC
.D UPDATE^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
Q
;
;
OC ; Cancelled
DC ; Discontinued
D DELETE^BRAPCC
D UPDATE^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
Q
;
;
RE ; Report verification
;
I +$G(RADFN)=0 Q
I +$G(RADTI)=0 Q
I +$G(RACNI)=0 Q
;
;We have a verified report and 'Send PCC at Examined' is NO,
;then create the PCC Visit and create the Women's Health entry
I $P($G(RA74("0")),U,5)="V",'RAPCC D Q
.D CREATE^BRAPCC
.D CREATE^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
;
;We have a verified report and 'Send PCC at Examined' is YES,
;but no PCC visit has been created,
;then create the PCC Visit and create the Women's Health entry
I $P($G(RA74("0")),U,5)="V",RAPCC D Q
.I +$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3) Q
.D CREATE^BRAPCC
.D CREATE^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
;
;We have a verified report and 'Send PCC at Examined' is YES,
;and we have a PCC visit already created,
;then update the V Rad entry and update the Women's Health entry
I $P($G(RA74("0")),U,5)="V",RAPCC D Q
.I +$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3)=0 Q
.D UPDTIMP^BRAPCC($G(RADFN),$G(RADTI))
.D UPDTDX^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
;
;Create visit and V RAD if exam status override to complete
;and No PCC Visit exists
I $P(^RA(72,$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3),0),U)["COMPLETE" D Q
.I +$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3) Q
.D CREATE^BRAPCC
.D CREATE^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
;
;Update visit and V Rad if exam status override to complete,
;and a PCC Visit exists
I $P(^RA(72,$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3),0),U)["COMPLETE" D Q
.I +$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3)=0 Q
.D UPDTIMP^BRAPCC($G(RADFN),$G(RADTI))
.D UPDTDX^BRAWH($G(RADFN),$G(RADTI),$G(RACNI))
;
Q
BRAPRAD ;CIA/PLS,IHS/ITSC/CLS - Radiology Protocol Event API ; 28 Apr 2014 4:26 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**1001,1003,1006**;Nov 01, 2010;Build 2
+2 ;
HOOK ;
+1 ;S $ZE="RAD PCC TEST" D ^ZTER ;IHS/ITSC/CLS testing
+2 NEW SEG,LP,DL1,DL2,RAPCC,ACTION,ORDSTS
+3 ; Get SEND PCC AT EXAMINED field
+4 SET RAPCC=+$GET(^RA(79,+$GET(RAMDIV),9999999))
+5 SET LP=0
+6 SET SEG=$$SEG("MSH",.LP)
+7 IF 'LP
QUIT
+8 SET DL1=$EXTRACT(SEG,4)
SET DL2=$EXTRACT(SEG,5)
+9 IF $PIECE(SEG,DL1,3)'="RADIOLOGY"
QUIT
+10 SET SEG=$$SEG("ORC",.LP)
+11 IF 'LP
QUIT
+12 ; Order Status
SET ORDSTS=$PIECE(SEG,DL1,6)
+13 ; Order Control
SET ACTION=$PIECE(SEG,DL1,2)
+14 IF ACTION?2U
IF $LENGTH($TEXT(@ACTION))
DO @ACTION
+15 QUIT
+16 ;
+17 ;
+18 ; Return specified segment, starting at line LP
SEG(TYP,LP) ;
+1 FOR
SET LP=$ORDER(RAMSG(LP))
IF 'LP
QUIT
IF $EXTRACT(RAMSG(LP),1,$LENGTH(TYP))=TYP
QUIT
+2 QUIT $SELECT(LP:RAMSG(LP),1:"")
+3 ;
+4 ;
SN ; New Order (doesn't create visit - "PCC" node absent)
+1 QUIT
+2 ;
+3 ;
SC ; Status Change (scheduled, registered, or unverified)
+1 ; Status Change (registered - ORSTS="ZR", ACTION="SC")
+2 ; Status Change (examined - ORSTS="", ACTION="SC")
+3 ; Status Change (unverified - ORSTS=ZU, ACTION="SC")
+4 ;
+5 ;Released report was unverified
+6 IF ORDSTS="ZU"
Begin DoDot:1
+7 DO UPDTIMP^BRAPCC($GET(RADFN),$GET(RADTI))
+8 DO UPDATE^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:1
+9 ;
+10 ;
+11 ;Don't create visit for registered
+12 ;Do create visit if examined and 'Send PCC at Examined' is YES
+13 IF ORDSTS=""
Begin DoDot:1
+14 IF RAPCC
Begin DoDot:2
+15 DO CREATE^BRAPCC
+16 DO CREATE^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
+19 ;
OH ; Exam on Hold, not even registered yet so no action necessary
+1 QUIT
+2 ;
+3 ;
OD ; Delete Exam and request
+1 IF RAPCC
Begin DoDot:1
+2 DO DELETE^BRAPCC
+3 DO UPDATE^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:1
+4 QUIT
+5 ;
+6 ;
OC ; Cancelled
DC ; Discontinued
+1 DO DELETE^BRAPCC
+2 DO UPDATE^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
+3 QUIT
+4 ;
+5 ;
RE ; Report verification
+1 ;
+2 IF +$GET(RADFN)=0
QUIT
+3 IF +$GET(RADTI)=0
QUIT
+4 IF +$GET(RACNI)=0
QUIT
+5 ;
+6 ;We have a verified report and 'Send PCC at Examined' is NO,
+7 ;then create the PCC Visit and create the Women's Health entry
+8 IF $PIECE($GET(RA74("0")),U,5)="V"
IF 'RAPCC
Begin DoDot:1
+9 DO CREATE^BRAPCC
+10 DO CREATE^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:1
QUIT
+11 ;
+12 ;We have a verified report and 'Send PCC at Examined' is YES,
+13 ;but no PCC visit has been created,
+14 ;then create the PCC Visit and create the Women's Health entry
+15 IF $PIECE($GET(RA74("0")),U,5)="V"
IF RAPCC
Begin DoDot:1
+16 IF +$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3)
QUIT
+17 DO CREATE^BRAPCC
+18 DO CREATE^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:1
QUIT
+19 ;
+20 ;We have a verified report and 'Send PCC at Examined' is YES,
+21 ;and we have a PCC visit already created,
+22 ;then update the V Rad entry and update the Women's Health entry
+23 IF $PIECE($GET(RA74("0")),U,5)="V"
IF RAPCC
Begin DoDot:1
+24 IF +$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3)=0
QUIT
+25 DO UPDTIMP^BRAPCC($GET(RADFN),$GET(RADTI))
+26 DO UPDTDX^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:1
QUIT
+27 ;
+28 ;Create visit and V RAD if exam status override to complete
+29 ;and No PCC Visit exists
+30 IF $PIECE(^RA(72,$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3),0),U)["COMPLETE"
Begin DoDot:1
+31 IF +$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3)
QUIT
+32 DO CREATE^BRAPCC
+33 DO CREATE^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:1
QUIT
+34 ;
+35 ;Update visit and V Rad if exam status override to complete,
+36 ;and a PCC Visit exists
+37 IF $PIECE(^RA(72,$PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3),0),U)["COMPLETE"
Begin DoDot:1
+38 IF +$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"PCC")),U,3)=0
QUIT
+39 DO UPDTIMP^BRAPCC($GET(RADFN),$GET(RADTI))
+40 DO UPDTDX^BRAWH($GET(RADFN),$GET(RADTI),$GET(RACNI))
End DoDot:1
QUIT
+41 ;
+42 QUIT
