- RTP32 ;MJK/TROY ISC;Detailed Non-fillable List ; 5/15/87 4:41 PM ;
- ;;v 2.0;Record Tracking;;10/22/91
- S RTDTEND=RTDT,X="T-100",%DT="" D ^%DT K %DT S RTDTX=Y
- I '$D(RTPULL) F RTDTE=RTBEG:0 S RTDTE=$O(^RTV(194.2,"C",RTDTE)) Q:RTDTEND<$P(RTDTE,".")!('RTDTE) F RTP=0:0 S RTP=$O(^RTV(194.2,"C",RTDTE,RTP)) Q:'RTP I $D(^RTV(194.2,RTP,0)),$P(^(0),"^",10)=1 D RTQ
- I $D(RTPULL) S RTP=RTPULL D RTQ
- K RTP,RTDTE,RTDTEND,RTDTX Q
- ;
- RTQ Q:'$D(^RTV(194.2,RTP,0)) S X=^(0) Q:$P(X,"^",6)="x"!($P(X,"^",15)'=+RTAPL) S RTB=+$P(X,"^",5)
- F RTQ=0:0 S RTQ=$O(^RTV(190.1,"AP",RTP,RTQ)) Q:'RTQ I $D(^RTV(190.1,RTQ,0)) S RTQ0=^(0) I $P(RTQ0,"^",6)="n",$P(RTQ0,"^",5)=RTB,$D(^RT(+RTQ0,0)),$P(^(0),"^")["DPT(" S RTE=$P(^(0),"^"),DFN=+^(0),RTDT=RTDTX D START^RTNQ3 S RTNONE=""
- K RTB,RTQ,RTE,DFN,RTDT Q
- ;
- DATE ;get date from parameters
- S RTPCE=20 D WINDOW^RTRPT
- S X1=DT,X2=-1 D C^%DTC
- I X=RTWND S RTWND=""
- Q
- ;
- BAR S RTIFN=RT S:$D(X) RTXSAV=X
- Q:'$D(^RT(RT,0)) S X=$P(^(0),U,3),T=5 Q:'$D(RTWND(X)) I $P(^(0),U,8)'<RTWND(X) Q
- D FMT^RTL1 I RTFMT S RTQSAV=RTQ,RTNUM=1 D PRT^RTL1
- S RTQ=RTQSAV S:$D(RTXSAV) X=RTXSAV
- K RTQSAV,RTXSAV,RTNUM Q
- ;
- DEV ;select barcode device
- D DATE Q:'RTWND Q:$D(RTIRE)
- S RTDEV=$P(RTFR,U,4) ;,IOP="HOME" D ^%ZIS K IOP
- S RTTASK=1 W !,"Select Barcode Printer ",!
- S RTDESC="Clinic List Labels ["_$P($P(RTAPL,U),";",2)_"]"
- 1 S RTVAR="RTDV^RTSORT^RTAPL^RTDT^RTLIST"_$S($D(RTPULL):"^RTPULL^RTPULL0",1:"")_"^RTTASK"_"^RTWND"
- I RTWND F JA=0:0 S JA=$O(RTWND(JA)) Q:'JA S RTVAR=RTVAR_"^RTWND("_JA_")"
- K JA S RTPGM="START^RTP3" D ZIS^RTUTL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTP32 1587 printed Jan 18, 2025@03:35:26 Page 2
- RTP32 ;MJK/TROY ISC;Detailed Non-fillable List ; 5/15/87 4:41 PM ;
- +1 ;;v 2.0;Record Tracking;;10/22/91
- +2 SET RTDTEND=RTDT
- SET X="T-100"
- SET %DT=""
- DO ^%DT
- KILL %DT
- SET RTDTX=Y
- +3 IF '$DATA(RTPULL)
- FOR RTDTE=RTBEG:0
- SET RTDTE=$ORDER(^RTV(194.2,"C",RTDTE))
- if RTDTEND<$PIECE(RTDTE,".")!('RTDTE)
- QUIT
- FOR RTP=0:0
- SET RTP=$ORDER(^RTV(194.2,"C",RTDTE,RTP))
- if 'RTP
- QUIT
- IF $DATA(^RTV(194.2,RTP,0))
- IF $PIECE(^(0),"^",10)=1
- DO RTQ
- +4 IF $DATA(RTPULL)
- SET RTP=RTPULL
- DO RTQ
- +5 KILL RTP,RTDTE,RTDTEND,RTDTX
- QUIT
- +6 ;
- RTQ if '$DATA(^RTV(194.2,RTP,0))
- QUIT
- SET X=^(0)
- if $PIECE(X,"^",6)="x"!($PIECE(X,"^",15)'=+RTAPL)
- QUIT
- SET RTB=+$PIECE(X,"^",5)
- +1 FOR RTQ=0:0
- SET RTQ=$ORDER(^RTV(190.1,"AP",RTP,RTQ))
- if 'RTQ
- QUIT
- IF $DATA(^RTV(190.1,RTQ,0))
- SET RTQ0=^(0)
- IF $PIECE(RTQ0,"^",6)="n"
- IF $PIECE(RTQ0,"^",5)=RTB
- IF $DATA(^RT(+RTQ0,0))
- IF $PIECE(^(0),"^")["DPT("
- SET RTE=$PIECE(^(0),"^")
- SET DFN=+^(0)
- SET RTDT=RTDTX
- DO START^RTNQ3
- SET RTNONE=""
- +2 KILL RTB,RTQ,RTE,DFN,RTDT
- QUIT
- +3 ;
- DATE ;get date from parameters
- +1 SET RTPCE=20
- DO WINDOW^RTRPT
- +2 SET X1=DT
- SET X2=-1
- DO C^%DTC
- +3 IF X=RTWND
- SET RTWND=""
- +4 QUIT
- +5 ;
- BAR SET RTIFN=RT
- if $DATA(X)
- SET RTXSAV=X
- +1 if '$DATA(^RT(RT,0))
- QUIT
- SET X=$PIECE(^(0),U,3)
- SET T=5
- if '$DATA(RTWND(X))
- QUIT
- IF $PIECE(^(0),U,8)'<RTWND(X)
- QUIT
- +2 DO FMT^RTL1
- IF RTFMT
- SET RTQSAV=RTQ
- SET RTNUM=1
- DO PRT^RTL1
- +3 SET RTQ=RTQSAV
- if $DATA(RTXSAV)
- SET X=RTXSAV
- +4 KILL RTQSAV,RTXSAV,RTNUM
- QUIT
- +5 ;
- DEV ;select barcode device
- +1 DO DATE
- if 'RTWND
- QUIT
- if $DATA(RTIRE)
- QUIT
- +2 ;,IOP="HOME" D ^%ZIS K IOP
- SET RTDEV=$PIECE(RTFR,U,4)
- +3 SET RTTASK=1
- WRITE !,"Select Barcode Printer ",!
- +4 SET RTDESC="Clinic List Labels ["_$PIECE($PIECE(RTAPL,U),";",2)_"]"
- 1 SET RTVAR="RTDV^RTSORT^RTAPL^RTDT^RTLIST"_$SELECT($DATA(RTPULL):"^RTPULL^RTPULL0",1:"")_"^RTTASK"_"^RTWND"
- +1 IF RTWND
- FOR JA=0:0
- SET JA=$ORDER(RTWND(JA))
- if 'JA
- QUIT
- SET RTVAR=RTVAR_"^RTWND("_JA_")"
- +2 KILL JA
- SET RTPGM="START^RTP3"
- DO ZIS^RTUTL
- +3 QUIT