RAORR3.m

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

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