RTQ5 ;MJK/TROY ISC;RADIOLOGY Link; ; 5/15/87 8:57 AM ;
;;v 2.0;Record Tracking;;10/22/91
I $D(RTAPL) D SAVE^RTPSET1,NEXT,RESTORE^RTPSET1 Q
NEXT Q:'$D(^DIC(195.4,1,"RAD")) S Y=+^("RAD") D APL1^RTPSET K SDSC D NOW^%DTC S SDTTM=%,SDPL=0,DFN=RADFN,IOP="" D ^%ZIS K IOP
I $D(RAMLC),$D(^RA(79.1,+RAMLC,0)) S Y=$P(^(0),"^"),Y=$S(Y?.N:Y,1:$O(^SC("B",Y,0))) S:$D(^SC(Y,0)) SDSC=Y
I '$D(SDSC) D RA^RTRAD G Q:Y<0 S SDSC=+$P(^RTV(195.9,Y,0),"^",2)
I '$D(^RT("AA",+RTAPL,DFN_";DPT(")) D NOASK^RTQ3 G Q
S RTRD(1)="Yes^indicate it is a wet reading",RTRD(2)="No^indicate it is not a wet reading",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Is this a WET READING? " D SET^RTRD K RTRD S:$E(X)="Y" RTCOM="**** WET READING ****" D QUE^RTQ2 W !
Q K RTDIV,RTFR,RTAPL,RTSYS,SDSC,SDTTM,SDPL,RTCOM Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTQ5 784 printed Nov 22, 2024@17:44:32 Page 2
RTQ5 ;MJK/TROY ISC;RADIOLOGY Link; ; 5/15/87 8:57 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 IF $DATA(RTAPL)
DO SAVE^RTPSET1
DO NEXT
DO RESTORE^RTPSET1
QUIT
NEXT if '$DATA(^DIC(195.4,1,"RAD"))
QUIT
SET Y=+^("RAD")
DO APL1^RTPSET
KILL SDSC
DO NOW^%DTC
SET SDTTM=%
SET SDPL=0
SET DFN=RADFN
SET IOP=""
DO ^%ZIS
KILL IOP
+1 IF $DATA(RAMLC)
IF $DATA(^RA(79.1,+RAMLC,0))
SET Y=$PIECE(^(0),"^")
SET Y=$SELECT(Y?.N:Y,1:$ORDER(^SC("B",Y,0)))
if $DATA(^SC(Y,0))
SET SDSC=Y
+2 IF '$DATA(SDSC)
DO RA^RTRAD
if Y<0
GOTO Q
SET SDSC=+$PIECE(^RTV(195.9,Y,0),"^",2)
+3 IF '$DATA(^RT("AA",+RTAPL,DFN_";DPT("))
DO NOASK^RTQ3
GOTO Q
+4 SET RTRD(1)="Yes^indicate it is a wet reading"
SET RTRD(2)="No^indicate it is not a wet reading"
SET RTRD("B")=2
SET RTRD(0)="S"
SET RTRD("A")="Is this a WET READING? "
DO SET^RTRD
KILL RTRD
if $EXTRACT(X)="Y"
SET RTCOM="**** WET READING ****"
DO QUE^RTQ2
WRITE !
Q KILL RTDIV,RTFR,RTAPL,RTSYS,SDSC,SDTTM,SDPL,RTCOM
QUIT
