RTRPT2 ;MJK,JSM/TROY ISC;Records Charged by Borrower Report;21 June 1986 ; 5/4/87 10:42 AM ;
;;v 2.0;Record Tracking;;10/22/91
W ! S DIC="^RTV(195.9,",DIC(0)="IAEMQ",DIC("S")="I $P(^(0),U,3)="_+RTAPL,DIC("A")="Select Borrower: " D ^DIC K DIC G Q:Y<0
S RTB=+Y,RTVAR="RTAPL^RTB^"_$S($D(RTTY):"^RTTY",1:"")_$S($D(RTDC("S")):"^RTDC(""S"")",1:""),RTPGM="START^RTRPT2" D ZIS^RTUTL G Q:POP D START G RTRPT2
;
START U IO K ^TMP($J),RTS,RTC,RTC1,RTX S RTC1=0,U="^",RTPAGE=0
F I=0:0 S I=$O(^RT("ABOR",RTB,I)) Q:'I I $D(^RT(I,0)),$S('$D(RTTY):1,$P(^(0),"^",3)=+RTTY:1,1:0),$P(^(0),"^",4)=+RTAPL S (RT1,Y)=I X:$D(RTDC("S")) RTDC("S") D SORT:$T!('$D(RTDC("S")))
D HD I RTC1 D REC I $D(RTASK),X'="^" D SELECT
W:'RTC1 !!?3,"No '",$S($D(RTTY):$P($P(RTTY,"^"),";",2),1:$P($P(RTAPL,"^"),";",2)),"' records charged to this borrower."
I $E(IOST,1,2)="C-",'$D(RTASK),$S('RTC1:1,1:RTLC>0),($Y+5)>IOSL W !!,"Press RETURN to continue: " R X:DTIME
Q K YSAV,RTVAR,RTPGM,RTPAGE,RTP,RTP1,RTASK,RTLC,RTB,RTTPH,RTC1,D,D1,T,V,O,I,^TMP($J) D CLOSE^RTUTL
K X1,Y,DUOUT,RTS,SSN,X,RTC,RT1,P Q
SORT Q:'$D(^RT(I,0)) S (RT0,X)=^(0),V=999-$P(X,"^",7),O=$S($D(^DIC(195.2,+$P(X,"^",3),0)):+$P(^(0),"^",4),1:0) G SORTQ:'O S RTT0=^(0)
S RTCL=$S($D(^RT(I,"CL")):^("CL"),1:"") D OVER1^RTUTL1 S RTOVER=X S Y=$E($P(RTCL,"^",6),1,12) D D^DIQ S D=Y
S Y=$P(RT0,"^") I Y["DPT" S SSN=$E($P(^DPT(+Y,0),"^",9),6,9)
D NAME^RTB S ^TMP($J,O,Y,V)=I_"^"_$P(RTT0,"^")_"^"_(999-V)_"^"_SSN_"^"_Y_"^"_D_"^"_RTOVER,RTC1=RTC1+1 W:$D(RTASK) "."
SORTQ K RT0,RTT0,RTCL,RTOVER,O,V,T,D,SSN Q
;
REC S RTC=0 F O=0:0 S O=$O(^TMP($J,O)) Q:'O D LINE^RTUTL3:RTC S RTP="%" F RTP1=0:0 S RTP=$O(^TMP($J,O,RTP)) Q:RTP="" S SSN=0 D VOL G RECQ:X="^"
RECQ Q
;
VOL F V=0:0 S V=$O(^TMP($J,O,RTP,V)) Q:'V S X=^(V),RTC=RTC+1 S:$D(RTASK) RTS(RTC)=+X D PRT Q:X="^"
Q
;
;
PRT S RTLC=RTLC+1 W !,$S($D(RTASK):RTC,1:""),?1,$E($P(X,"^",2),1,16),?18,"V",$P(X,"^",3),?23,$S('SSN:$P(X,"^",4),1:""),?28,$E($P(X,"^",5),1,19),?53,$P(X,"^",6),?72,$J($P(X,"^",7),5) S RTHD="HD",SSN=1 D PRT1 K RTHD Q
;
PRT1 I $D(^RTV(190.2,"AM","s",+X)) D FND^RTUTL1 S RTLC=RTLC+1
Q:IOSL>(RTLC+5) I $D(RTASK) Q:RTC'<RTC1 D SELECT S RTLC=0 W ! Q
S X="" I $E(IOST,1,2)="C-" W !!,"Press RETURN to continue or '^' to stop: " R X:DTIME S SSN=0 S:'$T X="^"
D:X'="^" @RTHD Q
;
HD S X="**** "_$S($D(RTTY):$P($P(RTTY,"^"),";",2),1:$P($P(RTAPL,"^"),";",2)_" Folders")_" Currently Charged to Borrower ****" D HD1
W !!?3,"Record Type",?18,"Vol",?23,$S($P(RTAPL,"^",9)["Patient":"SSN",1:""),?29,$S($P(RTAPL,"^",9)]"":$P(RTAPL,"^",9),1:"???"),?53,"Charged Since...",?72,"Overdue"
W !?3,"-----------",?18,"---",?23,"---------------------------",?53,"-----------------",?74,"----"
S RTLC=$Y Q
;
HD1 W @IOF,?(IOM-$L(X))/2,X S X="" D EQUALS^RTUTL3 S RTPAGE=RTPAGE+1,Y=RTB D BOR^RTB S P=$S($D(^RTV(195.9,RTB,0)):$P(^(0),"^",7),1:"")
W !,"Borrower : ",Y,?55,"Page: ",RTPAGE,!,"Phone/Location: ",P D NOW^%DTC S Y=$E(%,1,11) D D^DIQ W ?51,"Run Date: ",Y D EQUALS^RTUTL3 Q
;
SELECT S RTRD("A")="Choose: " S RTZ("RTC")=RTC D SEL^RTRD K RTRD I RTC S X="^" K RTZ Q
S RTC=RTZ("RTC") K RTZ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTRPT2 3129 printed Dec 13, 2024@02:34:39 Page 2
RTRPT2 ;MJK,JSM/TROY ISC;Records Charged by Borrower Report;21 June 1986 ; 5/4/87 10:42 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 WRITE !
SET DIC="^RTV(195.9,"
SET DIC(0)="IAEMQ"
SET DIC("S")="I $P(^(0),U,3)="_+RTAPL
SET DIC("A")="Select Borrower: "
DO ^DIC
KILL DIC
if Y<0
GOTO Q
+3 SET RTB=+Y
SET RTVAR="RTAPL^RTB^"_$SELECT($DATA(RTTY):"^RTTY",1:"")_$SELECT($DATA(RTDC("S")):"^RTDC(""S"")",1:"")
SET RTPGM="START^RTRPT2"
DO ZIS^RTUTL
if POP
GOTO Q
DO START
GOTO RTRPT2
+4 ;
START USE IO
KILL ^TMP($JOB),RTS,RTC,RTC1,RTX
SET RTC1=0
SET U="^"
SET RTPAGE=0
+1 FOR I=0:0
SET I=$ORDER(^RT("ABOR",RTB,I))
if 'I
QUIT
IF $DATA(^RT(I,0))
IF $SELECT('$DATA(RTTY):1,$PIECE(^(0),"^",3)=+RTTY:1,1:0)
IF $PIECE(^(0),"^",4)=+RTAPL
SET (RT1,Y)=I
if $DATA(RTDC("S"))
XECUTE RTDC("S")
if $TEST!('$DATA(RTDC("S")))
DO SORT
+2 DO HD
IF RTC1
DO REC
IF $DATA(RTASK)
IF X'="^"
DO SELECT
+3 if 'RTC1
WRITE !!?3,"No '",$SELECT($DATA(RTTY):$PIECE($PIECE(RTTY,"^"),";",2),1:$PIECE($PIECE(RTAPL,"^"),";",2)),"' records charged to this borrower."
+4 IF $EXTRACT(IOST,1,2)="C-"
IF '$DATA(RTASK)
IF $SELECT('RTC1:1,1:RTLC>0)
IF ($Y+5)>IOSL
WRITE !!,"Press RETURN to continue: "
READ X:DTIME
Q KILL YSAV,RTVAR,RTPGM,RTPAGE,RTP,RTP1,RTASK,RTLC,RTB,RTTPH,RTC1,D,D1,T,V,O,I,^TMP($JOB)
DO CLOSE^RTUTL
+1 KILL X1,Y,DUOUT,RTS,SSN,X,RTC,RT1,P
QUIT
SORT if '$DATA(^RT(I,0))
QUIT
SET (RT0,X)=^(0)
SET V=999-$PIECE(X,"^",7)
SET O=$SELECT($DATA(^DIC(195.2,+$PIECE(X,"^",3),0)):+$PIECE(^(0),"^",4),1:0)
if 'O
GOTO SORTQ
SET RTT0=^(0)
+1 SET RTCL=$SELECT($DATA(^RT(I,"CL")):^("CL"),1:"")
DO OVER1^RTUTL1
SET RTOVER=X
SET Y=$EXTRACT($PIECE(RTCL,"^",6),1,12)
DO D^DIQ
SET D=Y
+2 SET Y=$PIECE(RT0,"^")
IF Y["DPT"
SET SSN=$EXTRACT($PIECE(^DPT(+Y,0),"^",9),6,9)
+3 DO NAME^RTB
SET ^TMP($JOB,O,Y,V)=I_"^"_$PIECE(RTT0,"^")_"^"_(999-V)_"^"_SSN_"^"_Y_"^"_D_"^"_RTOVER
SET RTC1=RTC1+1
if $DATA(RTASK)
WRITE "."
SORTQ KILL RT0,RTT0,RTCL,RTOVER,O,V,T,D,SSN
QUIT
+1 ;
REC SET RTC=0
FOR O=0:0
SET O=$ORDER(^TMP($JOB,O))
if 'O
QUIT
if RTC
DO LINE^RTUTL3
SET RTP="%"
FOR RTP1=0:0
SET RTP=$ORDER(^TMP($JOB,O,RTP))
if RTP=""
QUIT
SET SSN=0
DO VOL
if X="^"
GOTO RECQ
RECQ QUIT
+1 ;
VOL FOR V=0:0
SET V=$ORDER(^TMP($JOB,O,RTP,V))
if 'V
QUIT
SET X=^(V)
SET RTC=RTC+1
if $DATA(RTASK)
SET RTS(RTC)=+X
DO PRT
if X="^"
QUIT
+1 QUIT
+2 ;
+3 ;
PRT SET RTLC=RTLC+1
WRITE !,$SELECT($DATA(RTASK):RTC,1:""),?1,$EXTRACT($PIECE(X,"^",2),1,16),?18,"V",$PIECE(X,"^",3),?23,$SELECT('SSN:$PIECE(X,"^",4),1:""),?28,$EXTRACT($PIECE(X,"^",5),1,19),?53,$PIECE(X,"^",6),?72,$JUSTIFY($PIECE(X,"^",7),5)
SET RTHD="HD"
SET SSN=1
DO PRT1
KILL RTHD
QUIT
+1 ;
PRT1 IF $DATA(^RTV(190.2,"AM","s",+X))
DO FND^RTUTL1
SET RTLC=RTLC+1
+1 if IOSL>(RTLC+5)
QUIT
IF $DATA(RTASK)
if RTC'<RTC1
QUIT
DO SELECT
SET RTLC=0
WRITE !
QUIT
+2 SET X=""
IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Press RETURN to continue or '^' to stop: "
READ X:DTIME
SET SSN=0
if '$TEST
SET X="^"
+3 if X'="^"
DO @RTHD
QUIT
+4 ;
HD SET X="**** "_$SELECT($DATA(RTTY):$PIECE($PIECE(RTTY,"^"),";",2),1:$PIECE($PIECE(RTAPL,"^"),";",2)_" Folders")_" Currently Charged to Borrower ****"
DO HD1
+1 WRITE !!?3,"Record Type",?18,"Vol",?23,$SELECT($PIECE(RTAPL,"^",9)["Patient":"SSN",1:""),?29,$SELECT($PIECE(RTAPL,"^",9)]"":$PIECE(RTAPL,"^",9),1:"???"),?53,"Charged Since...",?72,"Overdue"
+2 WRITE !?3,"-----------",?18,"---",?23,"---------------------------",?53,"-----------------",?74,"----"
+3 SET RTLC=$Y
QUIT
+4 ;
HD1 WRITE @IOF,?(IOM-$LENGTH(X))/2,X
SET X=""
DO EQUALS^RTUTL3
SET RTPAGE=RTPAGE+1
SET Y=RTB
DO BOR^RTB
SET P=$SELECT($DATA(^RTV(195.9,RTB,0)):$PIECE(^(0),"^",7),1:"")
+1 WRITE !,"Borrower : ",Y,?55,"Page: ",RTPAGE,!,"Phone/Location: ",P
DO NOW^%DTC
SET Y=$EXTRACT(%,1,11)
DO D^DIQ
WRITE ?51,"Run Date: ",Y
DO EQUALS^RTUTL3
QUIT
+2 ;
SELECT SET RTRD("A")="Choose: "
SET RTZ("RTC")=RTC
DO SEL^RTRD
KILL RTRD
IF RTC
SET X="^"
KILL RTZ
QUIT
+1 SET RTC=RTZ("RTC")
KILL RTZ
QUIT
