source: FOIAVistA/trunk/r/RECORD_TRACKING-RT/RTT.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1RTT ;MJK/TROY ISC;Record Transaction Option; ; 5/19/87 9:58 AM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3 D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
4 G:$D(^DOPT($P(X," ;"),10)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
5 D IXALL^DIK
6A D OVERALL^RTPSET Q:$D(XQUIT)
7 W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
8 ;
91 ;;Create a Label/Record/Volume
10 G ^RTDPA1
11 ;
122 ;;Delete a Record
13 G ^RTDEL
14 ;
153 ;;Charge-Out Records
16 K RTB S X="CHARGE-OUT" D TYPE G Q:'$D(RTMV) D CO G 3:'$D(RTFIN) K RTFIN G Q
17 ;
18CO I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 S RTFIN="" G Q
19 I RTMV0["TRANSFER TO" D DAT^RTTR G Q:'$D(RTPAST)
20 I RTMV0'["CHECK-IN" D PND^RTRPT IF 1
21 E D CPND^RTRPT
22 K RTFIN I $S('$D(RTB):1,'$D(^RTV(195.9,+RTB,0)):1,1:0) W ! K RTB D BOR^RTDPA32 I '$D(RTB) S RTFIN="" G Q
23 S:'$D(RTPROVFL) RTPROVFL=0 S RTN=0 K ^TMP($J,"RT") D SEL^RTT3
24Q K RTC,X1,RTESC,%DT,POP,RTA,I1,RTWND,RTMV,RTMV0,RTN,RTESC,RTPROVFL,Z0
25 I '$D(RTKEY) K ^TMP($J,"RT"),RTPAST,RTB
26 K SSN,N,X,Y,JL,RTAR,Y,I,DIE,DA,DR,RTJST,DR,P
27 Q
28 ;
294 ;;Re-charge a Record
30RC K RTB S X="RE-CHARGE" D TYPE G Q:'$D(RTMV) D CO G 4:'$D(RTFIN) K RTFIN G Q
31 ;
325 ;;Check-In Records
33 S X="CHECK-IN" D TYPE G Q:'$D(RTMV)
34CI S Y=$S($D(RTFR):+RTFR,1:"")
35 I 'Y S DIC(0)="IAMEQ",DIC="^RTV(195.9,",DIC("A")="Select Check-In File Room: ",DIC("S")="I $P(^(0),U,3)=+RTAPL,$P(^(0),U,13)=""F"" D DICS^RTDPA31",DIC("V")="I $P(Y(0),U,4)=""L""" D ^DIC K DIC Q:Y<0
36 S RTB=+Y D CO K RTFIN Q
37 ;
386 ;;Transfer Menu
39 G ^RTTR
40 ;
417 ;;Flag Record as Missing
42 G 7^RTT1
43 ;
448 ;;Record Charge-out to Patient
45 G 8^RTT4
46 ;
479 ;;Update Record's Attributes
48UP S RTSEL="S",DIC(0)="IAEMQ" D ^RTDPA K RTBCIFN,RTSEL G Q:'$D(RTY) S RTDR="13//NO;6;11//OK TO RETIRE^Update Record's Attributes: " D DR K RTDR G UP
49 ;
5010 ;;Inactivate/Re-activate Records
51 W ! S DIC="^DIC(195.3,",DIC(0)="IAEMQZ",DIC("A")="Select Movement Type: ",DIC("S")="I $P(^(0),U,3)=+RTAPL,$P(^(0),U)[""ACTIVATE""" D ^DIC K DIC G Q:Y<0 S RTMV=+Y,RTMV0=Y(0),RTINACFL=$P(Y(0),"^")["INACTIVATE"
52 K RTB D CO:RTINACFL,CI:'RTINACFL K RTFIN,RTINACFL,RTB G Q
53 ;
5411 ;;Multiple volume creation
55 G 11^RTT11
56 ;
5712 ;;Move Requests to last volume
58 G 12^RTT11
59 ;
60PARSE ;entry point to charge record with 'Y', RTB, RTMV and RTMV0 defined; optionally RTQ defined
61 ;Y=<record IFN>^<associated borrower>^<barcode input[y/n]>
62 S RT=+Y,RTPROV=$P(Y,"^",2),RTBCIFN=$P(Y,"^",3)
63CHG ;Entry pt with RT, RTB, RTMV and RTMV0 defined; optionally RTQ, RTPROV defined
64 S Y=$P(RTMV0,"^") I $S(Y["FOUND":1,Y["MISSING":1,$D(^RTV(190.2,"AM","m",RT)):0,1:1) S DA=RT,DIE="^RT(",DR="[RT CHARGE]" D ^DIE K DE,DQ D MOVE^RTUTL1:'$D(Y)
65 Q
66 ;
67TYPE K RTMV,RTMV0 S Y=+$O(^DIC(195.3,"AA",+RTAPL,X,0)) I 'Y!($O(^DIC(195.3,"AA",+RTAPL,X,Y)))!('$D(^DIC(195.3,Y,0))) W:'$D(ZTSK) !!,*7," '",X,"' Please check Movement Type file." Q
68 S RTMV=Y,RTMV0=^DIC(195.3,Y,0)
69 Q
70 ;
71DR F RTI=1:1 Q:'$D(RTY(RTI)) S RT=RTY(RTI) I $D(^RT(RT,0)) S RTE=$P(^(0),"^"),X1=$P(RTDR,"^",2)_$S($D(^DIC(195.2,+$P(^(0),"^",3),0)):$P(^(0),"^"),1:"")_" Vol: "_+$P(^RT(RT,0),"^",7) D DR1
72 K RT,RTY,RTI Q
73 ;
74DR1 D RECHD^RTUTL2 S RT0=^RT(RT,0),DA=RT,DIE="^RT(",DR=$P(RTDR,"^")_$S($D(^DIC(195.2,+$P(RT0,"^",3),0)):$S($P(^(0),"^",16)="y":";12",1:""),1:"") D ^DIE G DR1Q:$D(Y)
75 S X=^RT(RT,0) G DR1Q:'$D(^RTV(195.9,+$P(X,"^",6),0))!($P(X,"^",6)=$P(RT0,"^",6)) I $D(^RT(RT,"CL")),$P(^("CL"),"^",5)=$P(X,"^",6) G DR1Q
76 S RTRD(1)="Yes^check in record to new 'home' file room",RTRD(2)="No^not check it in",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Do you want to check in the record to the new home file room? " D SET^RTRD K RTRD G DR1Q:$E(X)'="Y"
77 S RTB=+$P(^RT(RT,0),"^",6) S X="CHECK-IN" D TYPE G DR1Q:'$D(RTMV) D CHG W:'$D(Y) !?5,"...record has been checked in"
78DR1Q K RT0,RTB,RTMV,RTMV0,X Q
79 ;
Note: See TracBrowser for help on using the repository browser.