source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTT4.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1RTT4 ;MJK/TROY ISC;Record Transaction Selection Utility; ; 5/8/87 10:48 AM ;
2 ;;v 2.0;Record Tracking;**9,21**;10/22/91
3 ;
4QUE X ^%ZOSF("UCI") S ZTUCI=Y,ZTRTN="DQ^RTT4",ZTDTH=$H D NOW^%DTC S ZTSAVE("RTQUEDT")=%,ZTIO=""
5 F JL="RTPAST","RTINACFL","RTB","RTMV","RTAPL","RTMV0","DUZ(0)" I $D(@JL) S ZTSAVE(JL)=""
6 S ZTDESC="Record Charge-out/Recharge etc.."
7 F I=0:0 S I=$O(^TMP($J,"RT","AR",I)) Q:'I S RTAR(I)=^(I)
8 I $D(RTAR) S ZTSAVE("RTAR(")=""
9 S RTN1=RTN D ^%ZTLOAD K RTAR Q
10 ;
11DQ S RTBKGRD=""
12 F RTN=0:0 S RTN=$O(RTAR(RTN)) Q:'RTN S Y=RTAR(RTN) D PARSE^RTT:$S('$D(^RT(+Y,"CL")):0,1:+$P(^("CL"),"^",6))'>RTQUEDT
13 K RTAR,RT,RTMV,RTMV0,RTB,RTPROV,RTN,RTINACFL,RTQUEDT,RTBKGRD,RTAPL Q
14 ;
158 ;;Record Charge-out to Patient
16 I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
17PT W ! S DIC(0)="IAEMQ",DIC="^DPT(" D ^DIC K DIC G PTQ:Y<0 S RTA=+RTAPL,RTB=+Y_";DPT(",DFN=+Y,Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y K RTA S RTB=Y
18 S X="CHARGE-OUT" D TYPE^RTT G PTQ:'$D(RTMV)
19 S X=$P(^DPT(DFN,0),"^"),RTSEL="S",DIC(0)="IEMQL" K RTY,DFN D ^RTDPA S:$D(RTESC) RTC=0 I $D(RTY) W ! S RTC=0 F RTY=0:0 S RTY=$O(RTY(RTY)) Q:'RTY S RT=+RTY(RTY) D CHK^RTT3 I $D(RT) S RTCHG="" D CHG^RTT K RTCHG I $D(RT) S RTC=RTC+1 K RT,RTBCIFN
20 I $D(RTC),RTC W !?3,"...record",$S(RTC>1:"s have",1:" has")," been charged out to the patient"
21PTQ K RTESC,RTMV,RTE,RTB,RTY,RTC,RT,RTSEL
22 K %,%DT,%YV,D0,DA,DGO,DI,DIC,DIC1,DIE,DIYS,DK,DL,DR,I1,N,POP,RTESC,RTMV0,RTZ,RTZ0,RTBCIFN,X,Y Q
23BC K RTESC S RTRD(1)="Yes^print a barcode label for this record",RTRD(2)="No^not print a barcode label for the record",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Would you like to print a barcode label? " D SET^RTRD K RTRD
24 I $E(X)'="Y" S:$E(X1)="^" RTESC="" G BCQ
25 S RTION=$P(RTFR,"^",4) D REC^RTL1 K RTION
26BCQ W ! Q
27 ;
28CHKIN I $P(^RT(RT,0),"^")[";DPT(",$D(^DPT(+^(0),.1)) W !?3,*7,"...patient is currently an inpatient on ward '",^(.1),"'",!
29 W:$P(^RT(RT,0),"^",13)="y" !?3,*7,"...some 'loose filing' needs to be done with this folder",!
30 S Y=+$P(^RT(RT,0),"^",6) Q:Y=RTB D BOR^RTB S X=$P(RTFR,"^",15) Q:"n"[X W !?3,*7,"...this record's home file room is '",Y,"'" I X="d" W ! Q
31 I X="q" S RTRD(1)="Yes^change home location",RTRD(2)="No^do not change location",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Do you want to change this record's HOME location? " D SET^RTRD K RTRD Q:$E(X)'="Y"
32 S DA=RT,DIE="^RT(",DR="6////"_RTB D ^DIE W:'$D(Y) !?6,"...home file room has been changed",!
33 ;
Note: See TracBrowser for help on using the repository browser.