- RAORR3 ;HISC/CAH,FPT,GJC AISC/DMK-OE/RR results display ;9/12/94 11:12
- ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- ;ORACTION=8
- ;$P(XQORNOD(0),"^",3)="Results Display"
- ;Called from RAORD2
- ;SET ^TMP($J,"RAEX",1)=Variables needed to display/print report
- N %
- S RADTE=9999999.9999-RADTI
- S RANME=$P($G(^DPT(RADFN,0)),"^"),DFN=RADFN,RASSN=$$SSN^RAUTL
- S Y=RADTE D D^RAUTL S RADATE=Y
- S RACN=+RA(0),RAPRC=$P($G(^RAMIS(71,+$P(RA(0),"^",2),0)),"^"),RAPRC=$S(RAPRC="":"Unknown",1:RAPRC)
- S RARPT=+$P(RA(0),"^",17),RAST=+$P(RA(0),"^",3)
- S ^TMP($J,"RAEX",1)=RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"_RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST
- S X=^TMP($J,"RAEX",1),RADUP(1)=$P(X,"^",10)_"^"_$P(X,"^",8)
- ;
- I $S($D(ZTQUEUED):1,$E(IOST,1,2)'="C-":1,1:0) S RAMIE=1 D DQ^RAORDQ
- I $E(IOST,1,2)="C-" D OERR^RART1
- K RA,RACI,RACNI,RADATE,RAMIE,RANME,RASSN,RAST,RADIV,RADIVPAR,RADPT0,RADTI,RAORD0,RAOSTS,RADFN,RAOIFN,^TMP($J,"RAEX")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAORR3 970 printed Mar 13, 2025@21:43:12 Page 2
- RAORR3 ;HISC/CAH,FPT,GJC AISC/DMK-OE/RR results display ;9/12/94 11:12
- +1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- +2 ;ORACTION=8
- +3 ;$P(XQORNOD(0),"^",3)="Results Display"
- +4 ;Called from RAORD2
- +5 ;SET ^TMP($J,"RAEX",1)=Variables needed to display/print report
- +6 NEW %
- +7 SET RADTE=9999999.9999-RADTI
- +8 SET RANME=$PIECE($GET(^DPT(RADFN,0)),"^")
- SET DFN=RADFN
- SET RASSN=$$SSN^RAUTL
- +9 SET Y=RADTE
- DO D^RAUTL
- SET RADATE=Y
- +10 SET RACN=+RA(0)
- SET RAPRC=$PIECE($GET(^RAMIS(71,+$PIECE(RA(0),"^",2),0)),"^")
- SET RAPRC=$SELECT(RAPRC="":"Unknown",1:RAPRC)
- +11 SET RARPT=+$PIECE(RA(0),"^",17)
- SET RAST=+$PIECE(RA(0),"^",3)
- +12 SET ^TMP($JOB,"RAEX",1)=RADFN_"^"_RADTI_"^"_RACNI_"^"_RANME_"^"_RASSN_"^"_RADATE_"^"_RADTE_"^"_RACN_"^"_RAPRC_"^"_RARPT_"^"_RAST
- +13 SET X=^TMP($JOB,"RAEX",1)
- SET RADUP(1)=$PIECE(X,"^",10)_"^"_$PIECE(X,"^",8)
- +14 ;
- +15 IF $SELECT($DATA(ZTQUEUED):1,$EXTRACT(IOST,1,2)'="C-":1,1:0)
- SET RAMIE=1
- DO DQ^RAORDQ
- +16 IF $EXTRACT(IOST,1,2)="C-"
- DO OERR^RART1
- +17 KILL RA,RACI,RACNI,RADATE,RAMIE,RANME,RASSN,RAST,RADIV,RADIVPAR,RADPT0,RADTI,RAORD0,RAOSTS,RADFN,RAOIFN,^TMP($JOB,"RAEX")
- +18 QUIT