RTUTL2 ;MJK/TROY ISC;Utility Routine; ; 5/15/87 11:39 AM ;
;;v 2.0;Record Tracking;;10/22/91
K RTY,RT,RTS,RTC,RTC1,RTL,RTX S RTC1=0,U="^",IOP="" D ^%ZIS K IOP
S RTIX="AA",RTIX("V")=+RTAPL S:$D(RTTY) RTIX="AT",RTIX("V")=+RTTY
F I=0:0 S I=$O(^RT(RTIX,RTIX("V"),RTE,I)) Q:'I I $D(^RT(I,0)) S (RT1,Y)=I D SCR^RTDPA D SORT:Y
I 'RTC1 D D1 I D1 D HD W !!?3,"No '",$S($D(RTTY):$P($P(RTTY,"^"),";",2),1:$P($P(RTAPL,"^"),";",2)),"' records ",$S('$D(RT1):"on file.",1:"available.")
I RTC1 D REC I '$D(RTESC),$D(RTSEL),RTC>RTC0 D SEL1
K RTS,RTIX,RTLC,RTC0,RTC1,D1,RTL,T,V,O,I Q
;
SORT Q:'$D(^RT(I,0)) S V=999-$P(^(0),"^",7),O=$S($D(^DIC(195.2,+$P(^(0),"^",3),0)):+$P(^(0),"^",4),1:0) Q:'O S T=$P(^(0),"^")
S RT=I D DEMOS2^RTUTL1 S RTL(O,V)=I_"^"_T_"^"_(999-V)_"^"_RTD("B")_"^"_RTD("D")_"^"_RTD("P1")_"^"_$S($D(RTD("PROV")):RTD("PROV")_"^"_RTD("PROVP"),1:"^")_"^"_$P(^RT(I,0),"^",12),RTC1=RTC1+1 K RTD,RT Q
;
REC S RTLC=0 D D1 G REC1:'D1 D HD
W !!?3,"Record Type",?21,"Vol",?26,"Current Borrower",?45,"Date Charged",?65,"Phone/Room #"
W !?3,"-----------",?21,"---",?26,"----------------",?45,"------------",?65,"------------" S RTLC=RTLC+7
REC1 S (RTC,RTC0)=0 F O=0:0 S O=$O(RTL(O)) Q:'O D LINE^RTUTL3:RTC&(D1) S:RTC&(D1) RTLC=RTLC+1 F V=0:0 S V=$O(RTL(O,V)) Q:'V S X=RTL(O,V),RTC=RTC+1,RTS(RTC)=+X I D1 D PRT,SEL G REC1Q:$D(RTESC)
REC1Q Q
;
PRT W ! W:$D(RTSEL) RTC W ?3,$E($P(X,"^",2),1,16),?21,"V",$P(X,"^",3),?26,$E($P(X,"^",4),1,18),?45,$P(X,"^",5),?65,$E($P(X,"^",6),1,14) S RTLC=RTLC+1
I $P(X,"^",7)]""!($P(X,"^",9)]"") W ! W:$P(X,"^",9)]"" ?3,"(",$P(X,"^",9),")" W:$P(X,"^",7)]"" ?26,"(",$P(X,"^",7),")" W:$P(X,"^",8)]"" ?65,"(",$P(X,"^",8),")" S RTLC=RTLC+1
I $P(X,"^",4)["MISSING" W *7 I $D(^RTV(190.2,"AM","s",+X)) D FND^RTUTL1 S RTLC=RTLC+1
I $D(^RT(+X,"I")),^("I"),DT>^("I") W !?3,"*** INACTIVE RECORD ***" S RTLC=RTLC+1
I $D(^RT(+X,"COMMENT")),^("COMMENT")]"" W !?3,"(",^("COMMENT"),")" S RTLC=RTLC+1
Q
;
SEL I $D(RTSEL),(RTLC+4)>20 S RTLC=0,RTZ("RTC")=RTC D SEL1 W ! S:'$D(RTY) RTC=RTZ("RTC") S:$D(RTESC) RTC0=RTC K RTZ Q
I (RTLC+4)>20,IOST["C-" S RTLC=0 K RTESC D ESC^RTRD
Q
;
SEL1 S RTRD("A")=$S($D(RTSEL("A")):RTSEL("A"),1:"Choose Record")_$S(RTSEL["S"&(RTC>1):"s",1:"")_" from List: " D SEL^RTRD K RTRD,RTESC
S:$D(RTY)!(X="...") RTESC="" I RTC S ^DISV($S($D(DUZ)'[0:DUZ,1:0),"^RT(")=+RTY(RTC) I RTC=1,'D1 W !!?3,"...",$P(^DIC(195.2,+$P(^RT(+RTY(1),0),"^",3),0),"^")," V",+$P(^RT(+RTY(1),0),"^",7)
Q
;
RECHD ;Entry point for record header w/X and RT defined
; X = header
; RT = file entry # to ^RT(
Q:'$D(^RT(RT,0)) S RTE=$P(^(0),"^"),RTD("SAVE")="" D PTHD,LINE^RTUTL3 S H="UNKNOWN",P="UNKNOWN" I $D(^RTV(195.9,+$P(^RT(RT,0),"^",6),0)) S P=$S($P(^(0),"^",8)]"":$P(^(0),"^",8),1:P),Y=$P(^(0),"^") D NAME^RTB S H=Y
W !,"Current : ",$E(RTD("B"),1,19),?32,"Phone : ",RTD("P"),?58,"|Home : ",$E(H,1,13),!,"Since... : ",RTD("D"),?32,"Location: ",RTD("L"),?58,"|Phone: ",$E(P,1,13) D FND^RTUTL1:$D(^RTV(190.2,"AM","s",RT))
W:$D(RTD("PROV")) !,"[Associated Borrower NAME/PHONE: ",RTD("PROV")," / ",RTD("PROVP"),"]"
D EQUALS^RTUTL3 K H,P,RTD,% Q
;
PTHD ;Entry point to print entity(patient) demographics; RTE defined
; RTE = variable pointer for entity [45;DPT(]
Q:'$D(RTE) W @IOF,?(80-$L(X1))/2,X1 D EQUALS^RTUTL3 S Y=RTE D DEMOS1^RTUTL1
W !,"Name : ",$E(RTD("N"),1,30) W:$D(RTD("SSN")) " (",RTD("SSN"),")" W ?55,"Page: ",$S($D(RTPAGE):RTPAGE,1:1)
W ! W:$D(RTD("DOB")) "Birth Date: ",RTD("DOB") W:$D(RTD("W")) ?26,"Ward: ",$E(RTD("W"),1,20) D NOW^%DTC S Y=$E(%,1,12) D D^DIQ W ?47,"Run Date: ",Y K % K:'$D(RTD("SAVE")) RTD
I RTE["DPT(",$D(^DPT(+RTE,.35)),+^(.35) W !?20,"***** Date of Death: " S Y=+^(.35) D D^DIQ W Y W " *****"
Q
;
D1 ;D1 is the flag that indicates whether data is displayed
S D1=1 S:$S($D(RTSEL)[0:0,RTSEL["D":1,1:0) D1=$S(RTSEL["L":0,RTSEL["O"&(RTC1=1):0,RTSEL["S":1,1:0) Q
;
HD S X1="**** "_$P($P(RTAPL,"^"),";",2)_" Profile ****" D PTHD D EQUALS^RTUTL3 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTUTL2 4026 printed Sep 23, 2025@20:11:28 Page 2
RTUTL2 ;MJK/TROY ISC;Utility Routine; ; 5/15/87 11:39 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 KILL RTY,RT,RTS,RTC,RTC1,RTL,RTX
SET RTC1=0
SET U="^"
SET IOP=""
DO ^%ZIS
KILL IOP
+3 SET RTIX="AA"
SET RTIX("V")=+RTAPL
if $DATA(RTTY)
SET RTIX="AT"
SET RTIX("V")=+RTTY
+4 FOR I=0:0
SET I=$ORDER(^RT(RTIX,RTIX("V"),RTE,I))
if 'I
QUIT
IF $DATA(^RT(I,0))
SET (RT1,Y)=I
DO SCR^RTDPA
if Y
DO SORT
+5 IF 'RTC1
DO D1
IF D1
DO HD
WRITE !!?3,"No '",$SELECT($DATA(RTTY):$PIECE($PIECE(RTTY,"^"),";",2),1:$PIECE($PIECE(RTAPL,"^"),";",2)),"' records ",$SELECT('$DATA(RT1):"on file.",1:"available.")
+6 IF RTC1
DO REC
IF '$DATA(RTESC)
IF $DATA(RTSEL)
IF RTC>RTC0
DO SEL1
+7 KILL RTS,RTIX,RTLC,RTC0,RTC1,D1,RTL,T,V,O,I
QUIT
+8 ;
SORT if '$DATA(^RT(I,0))
QUIT
SET V=999-$PIECE(^(0),"^",7)
SET O=$SELECT($DATA(^DIC(195.2,+$PIECE(^(0),"^",3),0)):+$PIECE(^(0),"^",4),1:0)
if 'O
QUIT
SET T=$PIECE(^(0),"^")
+1 SET RT=I
DO DEMOS2^RTUTL1
SET RTL(O,V)=I_"^"_T_"^"_(999-V)_"^"_RTD("B")_"^"_RTD("D")_"^"_RTD("P1")_"^"_$SELECT($DATA(RTD("PROV")):RTD("PROV")_"^"_RTD("PROVP"),1:"^")_"^"_$PIECE(^RT(I,0),"^",12)
SET RTC1=RTC1+1
KILL RTD,RT
QUIT
+2 ;
REC SET RTLC=0
DO D1
if 'D1
GOTO REC1
DO HD
+1 WRITE !!?3,"Record Type",?21,"Vol",?26,"Current Borrower",?45,"Date Charged",?65,"Phone/Room #"
+2 WRITE !?3,"-----------",?21,"---",?26,"----------------",?45,"------------",?65,"------------"
SET RTLC=RTLC+7
REC1 SET (RTC,RTC0)=0
FOR O=0:0
SET O=$ORDER(RTL(O))
if 'O
QUIT
if RTC&(D1)
DO LINE^RTUTL3
if RTC&(D1)
SET RTLC=RTLC+1
FOR V=0:0
SET V=$ORDER(RTL(O,V))
if 'V
QUIT
SET X=RTL(O,V)
SET RTC=RTC+1
SET RTS(RTC)=+X
IF D1
DO PRT
DO SEL
if $DATA(RTESC)
GOTO REC1Q
REC1Q QUIT
+1 ;
PRT WRITE !
if $DATA(RTSEL)
WRITE RTC
WRITE ?3,$EXTRACT($PIECE(X,"^",2),1,16),?21,"V",$PIECE(X,"^",3),?26,$EXTRACT($PIECE(X,"^",4),1,18),?45,$PIECE(X,"^",5),?65,$EXTRACT($PIECE(X,"^",6),1,14)
SET RTLC=RTLC+1
+1 IF $PIECE(X,"^",7)]""!($PIECE(X,"^",9)]"")
WRITE !
if $PIECE(X,"^",9)]""
WRITE ?3,"(",$PIECE(X,"^",9),")"
if $PIECE(X,"^",7)]""
WRITE ?26,"(",$PIECE(X,"^",7),")"
if $PIECE(X,"^",8)]""
WRITE ?65,"(",$PIECE(X,"^",8),")"
SET RTLC=RTLC+1
+2 IF $PIECE(X,"^",4)["MISSING"
WRITE *7
IF $DATA(^RTV(190.2,"AM","s",+X))
DO FND^RTUTL1
SET RTLC=RTLC+1
+3 IF $DATA(^RT(+X,"I"))
IF ^("I")
IF DT>^("I")
WRITE !?3,"*** INACTIVE RECORD ***"
SET RTLC=RTLC+1
+4 IF $DATA(^RT(+X,"COMMENT"))
IF ^("COMMENT")]""
WRITE !?3,"(",^("COMMENT"),")"
SET RTLC=RTLC+1
+5 QUIT
+6 ;
SEL IF $DATA(RTSEL)
IF (RTLC+4)>20
SET RTLC=0
SET RTZ("RTC")=RTC
DO SEL1
WRITE !
if '$DATA(RTY)
SET RTC=RTZ("RTC")
if $DATA(RTESC)
SET RTC0=RTC
KILL RTZ
QUIT
+1 IF (RTLC+4)>20
IF IOST["C-"
SET RTLC=0
KILL RTESC
DO ESC^RTRD
+2 QUIT
+3 ;
SEL1 SET RTRD("A")=$SELECT($DATA(RTSEL("A")):RTSEL("A"),1:"Choose Record")_$SELECT(RTSEL["S"&(RTC>1):"s",1:"")_" from List: "
DO SEL^RTRD
KILL RTRD,RTESC
+1 if $DATA(RTY)!(X="...")
SET RTESC=""
IF RTC
SET ^DISV($SELECT($DATA(DUZ)'[0:DUZ,1:0),"^RT(")=+RTY(RTC)
IF RTC=1
IF 'D1
WRITE !!?3,"...",$PIECE(^DIC(195.2,+$PIECE(^RT(+RTY(1),0),"^",3),0),"^")," V",+$PIECE(^RT(+RTY(1),0),"^",7)
+2 QUIT
+3 ;
RECHD ;Entry point for record header w/X and RT defined
+1 ; X = header
+2 ; RT = file entry # to ^RT(
+3 if '$DATA(^RT(RT,0))
QUIT
SET RTE=$PIECE(^(0),"^")
SET RTD("SAVE")=""
DO PTHD
DO LINE^RTUTL3
SET H="UNKNOWN"
SET P="UNKNOWN"
IF $DATA(^RTV(195.9,+$PIECE(^RT(RT,0),"^",6),0))
SET P=$SELECT($PIECE(^(0),"^",8)]"":$PIECE(^(0),"^",8),1:P)
SET Y=$PIECE(^(0),"^")
DO NAME^RTB
SET H=Y
+4 WRITE !,"Current : ",$EXTRACT(RTD("B"),1,19),?32,"Phone : ",RTD("P"),?58,"|Home : ",$EXTRACT(H,1,13),!,"Since... : ",RTD("D"),?32,"Location: ",RTD("L"),?58,"|Phone: ",$EXTRACT(P,1,13)
if $DATA(^RTV(190.2,"AM","s",RT))
DO FND^RTUTL1
+5 if $DATA(RTD("PROV"))
WRITE !,"[Associated Borrower NAME/PHONE: ",RTD("PROV")," / ",RTD("PROVP"),"]"
+6 DO EQUALS^RTUTL3
KILL H,P,RTD,%
QUIT
+7 ;
PTHD ;Entry point to print entity(patient) demographics; RTE defined
+1 ; RTE = variable pointer for entity [45;DPT(]
+2 if '$DATA(RTE)
QUIT
WRITE @IOF,?(80-$LENGTH(X1))/2,X1
DO EQUALS^RTUTL3
SET Y=RTE
DO DEMOS1^RTUTL1
+3 WRITE !,"Name : ",$EXTRACT(RTD("N"),1,30)
if $DATA(RTD("SSN"))
WRITE " (",RTD("SSN"),")"
WRITE ?55,"Page: ",$SELECT($DATA(RTPAGE):RTPAGE,1:1)
+4 WRITE !
if $DATA(RTD("DOB"))
WRITE "Birth Date: ",RTD("DOB")
if $DATA(RTD("W"))
WRITE ?26,"Ward: ",$EXTRACT(RTD("W"),1,20)
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO D^DIQ
WRITE ?47,"Run Date: ",Y
KILL %
if '$DATA(RTD("SAVE"))
KILL RTD
+5 IF RTE["DPT("
IF $DATA(^DPT(+RTE,.35))
IF +^(.35)
WRITE !?20,"***** Date of Death: "
SET Y=+^(.35)
DO D^DIQ
WRITE Y
WRITE " *****"
+6 QUIT
+7 ;
D1 ;D1 is the flag that indicates whether data is displayed
+1 SET D1=1
if $SELECT($DATA(RTSEL)[0
SET D1=$SELECT(RTSEL["L":0,RTSEL["O"&(RTC1=1):0,RTSEL["S":1,1:0)
QUIT
+2 ;
HD SET X1="**** "_$PIECE($PIECE(RTAPL,"^"),";",2)_" Profile ****"
DO PTHD
DO EQUALS^RTUTL3
QUIT
