- 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
