source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTUTL6.m@ 1432

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1RTUTL6 ;ALB/JLU-UTILITY PROGRAM;;9/10/90 10:00 AM;
2 ;;v 2.0;Record Tracking;;10/22/91
3BUL ;This is the entry for the cancelation bulletin from RTQ41,
4 ;
5 Q:'$D(^DIC(195.1,1,2)) S JZ=$P(^(2),U) Q:'JZ
6 I JZ>1 G:'$D(RTFR) E1 S JZ1=$P(RTFR,U),JZ1=$P(^RTV(195.9,JZ1,0),U,5) G:JZ1="" E2 S JM="D."_JZ1,XMY(JM)=""
7 I JZ=1!(JZ=3) I $P(^DIC(195.1,1,2),U,2) S JM=$P(^(2),U,2),JM="G."_$P(^XMB(3.8,JM,0),U)_"@"_^XMB("NAME"),XMY(JM)=""
8ALT Q:'$D(^RTV(190.1,DA,0)) S RTWK=^(0)
9 S JR=$P(RTWK,U),JA=DA
10 S RTCNBY=$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"Unknown")
11 S JL=$P(RTWK,U,5),JL=$P(^RTV(195.9,JL,0),U)
12 S RTRQT=$P(@(U_$P(JL,";",2)_$P(JL,";")_",0)"),U)
13 S JN=$P(RTWK,U) I JN S JG=^RT(JN,0),JV=$P(JG,U,7),JT=$P(JG,U,3),JN=$P(JG,U),JN=$P(@(U_$P(JN,";",2)_$P(JN,";")_",0)"),U),JT=$P(^DIC(195.2,JT,0),U)
14 E S (JN,JT,JV)="Unknown"
15 S XMB="RT CANCELED REQ",XMB(1)=JN,XMB(2)=JT,XMB(3)=JV,XMB(4)=JR,XMB(5)=RTRQT,XMB(6)=RTCNBY,XMB(7)=DA D ^XMB
16 I $D(JZ1),JZ>1 W !,*7," ...notice for cancelation of request #",DA," has been sent to device ",JZ1
17EX K XMB,XMTEXT,JS,JP,JL,RTTXT,RTWK,RTCNBY,RTRQT,JA,JG,JM,JN,JR,JT,JV,JZ,JZ1,XMY
18 Q
19 ;
20E1 W !!,*7," ...File room is not defined can not print to printer." K JZ1 D ALT Q
21E2 W !!,*7," ...Request printer not defined can not print to printer." K JZ1 D ALT Q
22 ;
23DT S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_$P("@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),"^",Y[".") S:Y="//" Y="" Q
24 Q
Note: See TracBrowser for help on using the repository browser.