BTPWRRAD ;VNGT/HS/ALA-Print Radiology Report ; 04 Feb 2009 9:22 AM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
;
EN(DATA,DFN,RACASE) ; EP -- BTPW RAD REPORT DISPLAY
;Description
; Generates a Display of a Radiology Record
;
;Input
; DFN - Patient IEN
; RACASE - Radiology Case Number
;
NEW UID,II,RAUTOE,RAXAM,RARPT,BN,QFL,RAY0,RAY1,RAY2,RAY3
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWRRAD",UID))
K @DATA
;
S II=0
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWRRAD D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
D HDR
;
K ^TMP($J,"RA AUTOE")
S RAXAM=$$FND(DFN,RACASE),RAUTOE=1
S RARPT=+$P(RAXAM,"^",9),QFL=0
I RARPT D I QFL G DONE
. NEW X
. S X=$G(^RARPT(+$G(RARPT),0))
. D INIT^RARTR
. I RAY0<0 S II=II+1,@DATA@(II)="Missing zero node data from the Patient File (2)",QFL=1
. I RAY1<0 S II=II+1,@DATA@(II)="Missing zero node data from the Rad/Nuc Med Patient File (70)",QFL=1
. I RAY2<0 S II=II+1,@DATA@(II)="Missing Registered Exams data",QFL=1
. I RAY3<0 S II=II+1,@DATA@(II)="Missing Examinations data",QFL=1
. I QFL S II=II+1,@DATA@(II)=$C(30) Q
. K ^TMP($J,"RA AUTOE")
D:RARPT PRT^RARTR
S BN=0
F S BN=$O(^TMP($J,"RA AUTOE",BN)) Q:'BN D
. S II=II+1,@DATA@(II)=^TMP($J,"RA AUTOE",BN)_$C(13)_$C(10)
;
S II=II+1,@DATA@(II)=$C(30)
;
DONE ;
;
K ^TMP($J,"RA AUTOE")
S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ;
S @DATA@(II)="T01024REPORT_TEXT"_$C(30)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
S II=II+1,@DATA@(II)=$C(31)
I $$TMPFL^BQIUL1("C")
Q
;
FND(RADFN,RARPT) ;EP
NEW RETURN,RCASE
S RETURN=""
S RARPN=$O(^RARPT("B",RARPT,"")) I RARPN="" Q RETURN
S RDTM=0
F S RDTM=$O(^RADPT(RADFN,"DT",RDTM)) Q:RDTM="AP" D
. S RPRCN=0
. F S RPRCN=$O(^RADPT(RADFN,"DT",RDTM,"P",RPRCN)) Q:'RPRCN D
.. I $P(^RADPT(RADFN,"DT",RDTM,"P",RPRCN,0),U,17)'=RARPN Q
.. S RCASE=^RADPT(RADFN,"DT",RDTM,"P",RPRCN,0)
.. S RETURN=RADFN_U_RDTM_U_RPRCN_U_$P(^DPT(RADFN,0),U,1)_U_U_U_$P(RCASE,U,1)_U_U_RARPN_U_$P(RCASE,U,3)
Q RETURN
BTPWRRAD ;VNGT/HS/ALA-Print Radiology Report ; 04 Feb 2009 9:22 AM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
+3 ;
EN(DATA,DFN,RACASE) ; EP -- BTPW RAD REPORT DISPLAY
+1 ;Description
+2 ; Generates a Display of a Radiology Record
+3 ;
+4 ;Input
+5 ; DFN - Patient IEN
+6 ; RACASE - Radiology Case Number
+7 ;
+8 NEW UID,II,RAUTOE,RAXAM,RARPT,BN,QFL,RAY0,RAY1,RAY2,RAY3
+9 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+10 SET DATA=$NAME(^TMP("BTPWRRAD",UID))
+11 KILL @DATA
+12 ;
+13 SET II=0
+14 ;
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWRRAD D UNWIND^%ZTER"
+16 ;
+17 DO HDR
+18 ;
+19 KILL ^TMP($JOB,"RA AUTOE")
+20 SET RAXAM=$$FND(DFN,RACASE)
SET RAUTOE=1
+21 SET RARPT=+$PIECE(RAXAM,"^",9)
SET QFL=0
+22 IF RARPT
Begin DoDot:1
+23 NEW X
+24 SET X=$GET(^RARPT(+$GET(RARPT),0))
+25 DO INIT^RARTR
+26 IF RAY0<0
SET II=II+1
SET @DATA@(II)="Missing zero node data from the Patient File (2)"
SET QFL=1
+27 IF RAY1<0
SET II=II+1
SET @DATA@(II)="Missing zero node data from the Rad/Nuc Med Patient File (70)"
SET QFL=1
+28 IF RAY2<0
SET II=II+1
SET @DATA@(II)="Missing Registered Exams data"
SET QFL=1
+29 IF RAY3<0
SET II=II+1
SET @DATA@(II)="Missing Examinations data"
SET QFL=1
+30 IF QFL
SET II=II+1
SET @DATA@(II)=$CHAR(30)
QUIT
+31 KILL ^TMP($JOB,"RA AUTOE")
End DoDot:1
IF QFL
GOTO DONE
+32 IF RARPT
DO PRT^RARTR
+33 SET BN=0
+34 FOR
SET BN=$ORDER(^TMP($JOB,"RA AUTOE",BN))
IF 'BN
QUIT
Begin DoDot:1
+35 SET II=II+1
SET @DATA@(II)=^TMP($JOB,"RA AUTOE",BN)_$CHAR(13)_$CHAR(10)
End DoDot:1
+36 ;
+37 SET II=II+1
SET @DATA@(II)=$CHAR(30)
+38 ;
DONE ;
+1 ;
+2 KILL ^TMP($JOB,"RA AUTOE")
+3 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+4 QUIT
+5 ;
HDR ;
+1 SET @DATA@(II)="T01024REPORT_TEXT"_$CHAR(30)
+2 QUIT
+3 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 IF $$TMPFL^BQIUL1("C")
+7 QUIT
+8 ;
FND(RADFN,RARPT) ;EP
+1 NEW RETURN,RCASE
+2 SET RETURN=""
+3 SET RARPN=$ORDER(^RARPT("B",RARPT,""))
IF RARPN=""
QUIT RETURN
+4 SET RDTM=0
+5 FOR
SET RDTM=$ORDER(^RADPT(RADFN,"DT",RDTM))
IF RDTM="AP"
QUIT
Begin DoDot:1
+6 SET RPRCN=0
+7 FOR
SET RPRCN=$ORDER(^RADPT(RADFN,"DT",RDTM,"P",RPRCN))
IF 'RPRCN
QUIT
Begin DoDot:2
+8 IF $PIECE(^RADPT(RADFN,"DT",RDTM,"P",RPRCN,0),U,17)'=RARPN
QUIT
+9 SET RCASE=^RADPT(RADFN,"DT",RDTM,"P",RPRCN,0)
+10 SET RETURN=RADFN_U_RDTM_U_RPRCN_U_$PIECE(^DPT(RADFN,0),U,1)_U_U_U_$PIECE(RCASE,U,1)_U_U_RARPN_U_$PIECE(RCASE,U,3)
End DoDot:2
End DoDot:1
+11 QUIT RETURN
