- RTREP ;JLU/TROY ISC RPW/BUF;RT Pull List Retrieval Rates; 2-19-87
- ;;v 2.0;Record Tracking;**25**;10/22/91
- 0 S RT=0,DIR(0)="S^1:Date Range;2:One Day;3:Single Pull List",DIR("?",1)="1 Date Range A range of days",DIR("?",2)="2 One Day A single day"
- S DIR("?",3)="3 Single Pull List Only one pull list",DIR("?")=" ^ Stop"
- D ^DIR K DIR G:Y=U END
- S RTX=Y,RTX1=RTX G:(RTX=1)!(RTX=2)!(RTX=3) @RTX W !,"??",*7 G 0
- 1 ;Date Range
- D RTDSF G:Y=U END
- 10 W ! S %DT="AEX",%DT("A")="From Date: " D ^%DT G:Y<0 END S RTDT1=Y,%DT("A")=" To Date: " D ^%DT G:Y<0 END S RTDT2=Y
- I RTDT2<RTDT1 W !,*7,"ENDING 'to' date is before the STARTING 'from' date" G 10
- S ZTRTN="EN1^RTREP" D RTCOM1,RTCOM G:RT=1 END
- EN1 D INITS,INITS1,HDR^RTREP1:RTDSF,INITS2^RTREP1:RTDSF
- F RTDT=RTDT1-.1:0 S RTDT=$O(^RTV(194.2,"C",RTDT)) Q:RTDT'>0!(RTDT>RTDT2) D 11
- I 'RTDSF D PRNT^RTREP1 G END
- I RTDSS="D" D DPRT^RTREP1,PRNT^RTREP1 I 1
- E D APRT^RTREP1,PRNT^RTREP1
- G END
- ;
- 11 F RTPLN=0:0 S RTPLN=$O(^RTV(194.2,"C",RTDT,RTPLN)) Q:RTPLN'>0 I $P(^RTV(194.2,RTPLN,0),U,6)'="x",$P(^(0),U,15)=+RTAPL D @$S('RTDSF:"RTLP^RTREP1",RTDSS="D":"DSORT",1:"ASORT")
- Q
- ;
- 2 ; One Date
- D RTDSF G:Y=U END S %DT="AEX" D ^%DT G:Y<0 END S RTDT1=Y
- S ZTRTN="EN2^RTREP" D RTCOM1,RTCOM G:RT=1 END
- EN2 D INITS,INITS1,HDR^RTREP1:RTDSF,INITS2^RTREP1:RTDSF
- F RTPLN=0:0 S RTPLN=$O(^RTV(194.2,"C",RTDT1,RTPLN)) Q:RTPLN'>0 I $P(^RTV(194.2,RTPLN,0),U,6)'="x",$P(^(0),U,15)=+RTAPL D @$S('RTDSF:"RTLP^RTREP1",RTDSS="D":"DSORT",1:"ASORT")
- I 'RTDSF D PRNT^RTREP1 G END
- I RTDSS="D" D DPRT^RTREP1,PRNT^RTREP1 I 1
- E D APRT^RTREP1,PRNT^RTREP1
- G END
- ;
- 3 ;One Pull List
- S RTDSF=1,DIC="^RTV(194.2,",DIC(0)="AEQM" D ^DIC G:Y<0 END S RTLN=$P(Y,U,2),RTPLN=+Y
- S ZTRTN="EN3^RTREP" D RTCOM1,RTCOM G:RT=1 END
- EN3 D INITS1 W @IOF D INITS,HDR^RTREP1,INITS2^RTREP1,RTLP^RTREP1
- ;
- END K %DT,%ZIS,RTSF,RTDT,RTDT2,RTDTT,RTI,RTINE,RTPAGE,RTPLN,RTRTN,RTST,RTX,DIC,RTNAM,RTXP,RTLN,RTX1,RTDSF,DIC,RTDT1,Y,ZTRTN,RTRD,X1,RT,^TMP($J),RTDSS,RTX3,RTNM,RTNM1,X,DUOUT,DIRUT,RTIST,RTIST1,RTNB,RTX2,RTXP2,RTP1
- D ^%ZISC
- K IO("Q"),ZTIO
- Q
- ASORT ; Alpha Sort
- S ^TMP($J,$P(^RTV(194.2,RTPLN,0),U),RTPLN)=""
- Q
- DSORT ; Division Sort
- S ^TMP($J,$P(^RTV(194.2,RTPLN,0),U,12),$P(^(0),U),RTPLN)=""
- Q
- ;Input Prompt
- RTDSF S DIR(0)="S^D:Detailed;S:Summary",DIR("B")="Summary",DIR("A")="Type of Report",DIR("?")="Summary - Total of all pull lists, Detailed - Totals for each pull list." D ^DIR K DIR S RTDSF=$S(Y="D":1,1:0)
- Q:Y'="D"
- RTDSS S DIR(0)="S^D:Division;A:Alphabetic",DIR("B")="Alphabetic",DIR("A")="Sorted by",DIR("?")="Division - Groups of Divisions and subtotals, Alphabetic - Alphabetic list." D ^DIR K DIR S RTDSS=Y
- Q
- ;Initialize Variables
- INITS F RTI=0,1,2 F RTX="c","x","r","n" S RTST(RTI,RTX)=0
- S RTINE="=" F RTI=1:1:IOM-2 S RTINE=RTINE_"="
- S U="^",RTPAGE=0,%DT="" D NOW^%DTC S Y=$E(%,1,12) D D^DIQ S RTDTT=Y K ^TMP($J)
- Q
- INITS1 U IO K ZTSK Q
- RTCOM I $D(IO("Q")) S ZTDESC="RT Retrievability Report",RT=1,ZTSAVE("RT*")="",ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL D ^%ZTLOAD K IO("Q"),ZTSK,ZTRT
- Q
- RTCOM1 S %ZIS="QM",%=0 D ^%ZIS I POP S RT=1 Q
- QU I (RTDSF!(RTX1=3))&(IOM=80) W !,*7,?8,"Margin for Detailed usually 132 ",!,?8,"Are you sure 80 Y,N" D YN^DICN G RTCOM1:%=2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTREP 3292 printed Feb 19, 2025@00:01:06 Page 2
- RTREP ;JLU/TROY ISC RPW/BUF;RT Pull List Retrieval Rates; 2-19-87
- +1 ;;v 2.0;Record Tracking;**25**;10/22/91
- 0 SET RT=0
- SET DIR(0)="S^1:Date Range;2:One Day;3:Single Pull List"
- SET DIR("?",1)="1 Date Range A range of days"
- SET DIR("?",2)="2 One Day A single day"
- +1 SET DIR("?",3)="3 Single Pull List Only one pull list"
- SET DIR("?")=" ^ Stop"
- +2 DO ^DIR
- KILL DIR
- if Y=U
- GOTO END
- +3 SET RTX=Y
- SET RTX1=RTX
- if (RTX=1)!(RTX=2)!(RTX=3)
- GOTO @RTX
- WRITE !,"??",*7
- GOTO 0
- 1 ;Date Range
- +1 DO RTDSF
- if Y=U
- GOTO END
- 10 WRITE !
- SET %DT="AEX"
- SET %DT("A")="From Date: "
- DO ^%DT
- if Y<0
- GOTO END
- SET RTDT1=Y
- SET %DT("A")=" To Date: "
- DO ^%DT
- if Y<0
- GOTO END
- SET RTDT2=Y
- +1 IF RTDT2<RTDT1
- WRITE !,*7,"ENDING 'to' date is before the STARTING 'from' date"
- GOTO 10
- +2 SET ZTRTN="EN1^RTREP"
- DO RTCOM1
- DO RTCOM
- if RT=1
- GOTO END
- EN1 DO INITS
- DO INITS1
- if RTDSF
- DO HDR^RTREP1
- if RTDSF
- DO INITS2^RTREP1
- +1 FOR RTDT=RTDT1-.1:0
- SET RTDT=$ORDER(^RTV(194.2,"C",RTDT))
- if RTDT'>0!(RTDT>RTDT2)
- QUIT
- DO 11
- +2 IF 'RTDSF
- DO PRNT^RTREP1
- GOTO END
- +3 IF RTDSS="D"
- DO DPRT^RTREP1
- DO PRNT^RTREP1
- IF 1
- +4 IF '$TEST
- DO APRT^RTREP1
- DO PRNT^RTREP1
- +5 GOTO END
- +6 ;
- 11 FOR RTPLN=0:0
- SET RTPLN=$ORDER(^RTV(194.2,"C",RTDT,RTPLN))
- if RTPLN'>0
- QUIT
- IF $PIECE(^RTV(194.2,RTPLN,0),U,6)'="x"
- IF $PIECE(^(0),U,15)=+RTAPL
- DO @$SELECT('RTDSF:"RTLP^RTREP1",RTDSS="D":"DSORT",1:"ASORT")
- +1 QUIT
- +2 ;
- 2 ; One Date
- +1 DO RTDSF
- if Y=U
- GOTO END
- SET %DT="AEX"
- DO ^%DT
- if Y<0
- GOTO END
- SET RTDT1=Y
- +2 SET ZTRTN="EN2^RTREP"
- DO RTCOM1
- DO RTCOM
- if RT=1
- GOTO END
- EN2 DO INITS
- DO INITS1
- if RTDSF
- DO HDR^RTREP1
- if RTDSF
- DO INITS2^RTREP1
- +1 FOR RTPLN=0:0
- SET RTPLN=$ORDER(^RTV(194.2,"C",RTDT1,RTPLN))
- if RTPLN'>0
- QUIT
- IF $PIECE(^RTV(194.2,RTPLN,0),U,6)'="x"
- IF $PIECE(^(0),U,15)=+RTAPL
- DO @$SELECT('RTDSF:"RTLP^RTREP1",RTDSS="D":"DSORT",1:"ASORT")
- +2 IF 'RTDSF
- DO PRNT^RTREP1
- GOTO END
- +3 IF RTDSS="D"
- DO DPRT^RTREP1
- DO PRNT^RTREP1
- IF 1
- +4 IF '$TEST
- DO APRT^RTREP1
- DO PRNT^RTREP1
- +5 GOTO END
- +6 ;
- 3 ;One Pull List
- +1 SET RTDSF=1
- SET DIC="^RTV(194.2,"
- SET DIC(0)="AEQM"
- DO ^DIC
- if Y<0
- GOTO END
- SET RTLN=$PIECE(Y,U,2)
- SET RTPLN=+Y
- +2 SET ZTRTN="EN3^RTREP"
- DO RTCOM1
- DO RTCOM
- if RT=1
- GOTO END
- EN3 DO INITS1
- WRITE @IOF
- DO INITS
- DO HDR^RTREP1
- DO INITS2^RTREP1
- DO RTLP^RTREP1
- +1 ;
- END KILL %DT,%ZIS,RTSF,RTDT,RTDT2,RTDTT,RTI,RTINE,RTPAGE,RTPLN,RTRTN,RTST,RTX,DIC,RTNAM,RTXP,RTLN,RTX1,RTDSF,DIC,RTDT1,Y,ZTRTN,RTRD,X1,RT,^TMP($JOB),RTDSS,RTX3,RTNM,RTNM1,X,DUOUT,DIRUT,RTIST,RTIST1,RTNB,RTX2,RTXP2,RTP1
- +1 DO ^%ZISC
- +2 KILL IO("Q"),ZTIO
- +3 QUIT
- ASORT ; Alpha Sort
- +1 SET ^TMP($JOB,$PIECE(^RTV(194.2,RTPLN,0),U),RTPLN)=""
- +2 QUIT
- DSORT ; Division Sort
- +1 SET ^TMP($JOB,$PIECE(^RTV(194.2,RTPLN,0),U,12),$PIECE(^(0),U),RTPLN)=""
- +2 QUIT
- +3 ;Input Prompt
- RTDSF SET DIR(0)="S^D:Detailed;S:Summary"
- SET DIR("B")="Summary"
- SET DIR("A")="Type of Report"
- SET DIR("?")="Summary - Total of all pull lists, Detailed - Totals for each pull list."
- DO ^DIR
- KILL DIR
- SET RTDSF=$SELECT(Y="D":1,1:0)
- +1 if Y'="D"
- QUIT
- RTDSS SET DIR(0)="S^D:Division;A:Alphabetic"
- SET DIR("B")="Alphabetic"
- SET DIR("A")="Sorted by"
- SET DIR("?")="Division - Groups of Divisions and subtotals, Alphabetic - Alphabetic list."
- DO ^DIR
- KILL DIR
- SET RTDSS=Y
- +1 QUIT
- +2 ;Initialize Variables
- INITS FOR RTI=0,1,2
- FOR RTX="c","x","r","n"
- SET RTST(RTI,RTX)=0
- +1 SET RTINE="="
- FOR RTI=1:1:IOM-2
- SET RTINE=RTINE_"="
- +2 SET U="^"
- SET RTPAGE=0
- SET %DT=""
- DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO D^DIQ
- SET RTDTT=Y
- KILL ^TMP($JOB)
- +3 QUIT
- INITS1 USE IO
- KILL ZTSK
- QUIT
- RTCOM IF $DATA(IO("Q"))
- SET ZTDESC="RT Retrievability Report"
- SET RT=1
- SET ZTSAVE("RT*")=""
- SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK,ZTRT
- +1 QUIT
- RTCOM1 SET %ZIS="QM"
- SET %=0
- DO ^%ZIS
- IF POP
- SET RT=1
- QUIT
- QU IF (RTDSF!(RTX1=3))&(IOM=80)
- WRITE !,*7,?8,"Margin for Detailed usually 132 ",!,?8,"Are you sure 80 Y,N"
- DO YN^DICN
- if %=2
- GOTO RTCOM1
- +1 QUIT