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