- 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
