source: FOIAVistA/trunk/r/RECORD_TRACKING-RT/RTUTL2.m@ 1458

Last change on this file since 1458 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RTUTL2 ;MJK/TROY ISC;Utility Routine; ; 5/15/87 11:39 AM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3 K RTY,RT,RTS,RTC,RTC1,RTL,RTX S RTC1=0,U="^",IOP="" D ^%ZIS K IOP
4 S RTIX="AA",RTIX("V")=+RTAPL S:$D(RTTY) RTIX="AT",RTIX("V")=+RTTY
5 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
6 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.")
7 I RTC1 D REC I '$D(RTESC),$D(RTSEL),RTC>RTC0 D SEL1
8 K RTS,RTIX,RTLC,RTC0,RTC1,D1,RTL,T,V,O,I Q
9 ;
10SORT 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),"^")
11 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
12 ;
13REC S RTLC=0 D D1 G REC1:'D1 D HD
14 W !!?3,"Record Type",?21,"Vol",?26,"Current Borrower",?45,"Date Charged",?65,"Phone/Room #"
15 W !?3,"-----------",?21,"---",?26,"----------------",?45,"------------",?65,"------------" S RTLC=RTLC+7
16REC1 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)
17REC1Q Q
18 ;
19PRT 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
20 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
21 I $P(X,"^",4)["MISSING" W *7 I $D(^RTV(190.2,"AM","s",+X)) D FND^RTUTL1 S RTLC=RTLC+1
22 I $D(^RT(+X,"I")),^("I"),DT>^("I") W !?3,"*** INACTIVE RECORD ***" S RTLC=RTLC+1
23 I $D(^RT(+X,"COMMENT")),^("COMMENT")]"" W !?3,"(",^("COMMENT"),")" S RTLC=RTLC+1
24 Q
25 ;
26SEL 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
27 I (RTLC+4)>20,IOST["C-" S RTLC=0 K RTESC D ESC^RTRD
28 Q
29 ;
30SEL1 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
31 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)
32 Q
33 ;
34RECHD ;Entry point for record header w/X and RT defined
35 ; X = header
36 ; RT = file entry # to ^RT(
37 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
38 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))
39 W:$D(RTD("PROV")) !,"[Associated Borrower NAME/PHONE: ",RTD("PROV")," / ",RTD("PROVP"),"]"
40 D EQUALS^RTUTL3 K H,P,RTD,% Q
41 ;
42PTHD ;Entry point to print entity(patient) demographics; RTE defined
43 ; RTE = variable pointer for entity [45;DPT(]
44 Q:'$D(RTE) W @IOF,?(80-$L(X1))/2,X1 D EQUALS^RTUTL3 S Y=RTE D DEMOS1^RTUTL1
45 W !,"Name : ",$E(RTD("N"),1,30) W:$D(RTD("SSN")) " (",RTD("SSN"),")" W ?55,"Page: ",$S($D(RTPAGE):RTPAGE,1:1)
46 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
47 I RTE["DPT(",$D(^DPT(+RTE,.35)),+^(.35) W !?20,"***** Date of Death: " S Y=+^(.35) D D^DIQ W Y W " *****"
48 Q
49 ;
50D1 ;D1 is the flag that indicates whether data is displayed
51 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
52 ;
53HD S X1="**** "_$P($P(RTAPL,"^"),";",2)_" Profile ****" D PTHD D EQUALS^RTUTL3 Q
Note: See TracBrowser for help on using the repository browser.