- 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 Feb 19, 2025@00:01:03 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
