RTUTL6 ;ALB/JLU-UTILITY PROGRAM;;9/10/90 10:00 AM;
;;v 2.0;Record Tracking;;10/22/91
BUL ;This is the entry for the cancelation bulletin from RTQ41,
;
Q:'$D(^DIC(195.1,1,2)) S JZ=$P(^(2),U) Q:'JZ
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)=""
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)=""
ALT Q:'$D(^RTV(190.1,DA,0)) S RTWK=^(0)
S JR=$P(RTWK,U),JA=DA
S RTCNBY=$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"Unknown")
S JL=$P(RTWK,U,5),JL=$P(^RTV(195.9,JL,0),U)
S RTRQT=$P(@(U_$P(JL,";",2)_$P(JL,";")_",0)"),U)
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)
E S (JN,JT,JV)="Unknown"
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
I $D(JZ1),JZ>1 W !,*7," ...notice for cancelation of request #",DA," has been sent to device ",JZ1
EX K XMB,XMTEXT,JS,JP,JL,RTTXT,RTWK,RTCNBY,RTRQT,JA,JG,JM,JN,JR,JT,JV,JZ,JZ1,XMY
Q
;
E1 W !!,*7," ...File room is not defined can not print to printer." K JZ1 D ALT Q
E2 W !!,*7," ...Request printer not defined can not print to printer." K JZ1 D ALT Q
;
DT 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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTUTL6 1427 printed Dec 13, 2024@02:35:11 Page 2
RTUTL6 ;ALB/JLU-UTILITY PROGRAM;;9/10/90 10:00 AM;
+1 ;;v 2.0;Record Tracking;;10/22/91
BUL ;This is the entry for the cancelation bulletin from RTQ41,
+1 ;
+2 if '$DATA(^DIC(195.1,1,2))
QUIT
SET JZ=$PIECE(^(2),U)
if 'JZ
QUIT
+3 IF JZ>1
if '$DATA(RTFR)
GOTO E1
SET JZ1=$PIECE(RTFR,U)
SET JZ1=$PIECE(^RTV(195.9,JZ1,0),U,5)
if JZ1=""
GOTO E2
SET JM="D."_JZ1
SET XMY(JM)=""
+4 IF JZ=1!(JZ=3)
IF $PIECE(^DIC(195.1,1,2),U,2)
SET JM=$PIECE(^(2),U,2)
SET JM="G."_$PIECE(^XMB(3.8,JM,0),U)_"@"_^XMB("NAME")
SET XMY(JM)=""
ALT if '$DATA(^RTV(190.1,DA,0))
QUIT
SET RTWK=^(0)
+1 SET JR=$PIECE(RTWK,U)
SET JA=DA
+2 SET RTCNBY=$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"Unknown")
+3 SET JL=$PIECE(RTWK,U,5)
SET JL=$PIECE(^RTV(195.9,JL,0),U)
+4 SET RTRQT=$PIECE(@(U_$PIECE(JL,";",2)_$PIECE(JL,";")_",0)"),U)
+5 SET JN=$PIECE(RTWK,U)
IF JN
SET JG=^RT(JN,0)
SET JV=$PIECE(JG,U,7)
SET JT=$PIECE(JG,U,3)
SET JN=$PIECE(JG,U)
SET JN=$PIECE(@(U_$PIECE(JN,";",2)_$PIECE(JN,";")_",0)"),U)
SET JT=$PIECE(^DIC(195.2,JT,0),U)
+6 IF '$TEST
SET (JN,JT,JV)="Unknown"
+7 SET XMB="RT CANCELED REQ"
SET XMB(1)=JN
SET XMB(2)=JT
SET XMB(3)=JV
SET XMB(4)=JR
SET XMB(5)=RTRQT
SET XMB(6)=RTCNBY
SET XMB(7)=DA
DO ^XMB
+8 IF $DATA(JZ1)
IF JZ>1
WRITE !,*7," ...notice for cancelation of request #",DA," has been sent to device ",JZ1
EX KILL XMB,XMTEXT,JS,JP,JL,RTTXT,RTWK,RTCNBY,RTRQT,JA,JG,JM,JN,JR,JT,JV,JZ,JZ1,XMY
+1 QUIT
+2 ;
E1 WRITE !!,*7," ...File room is not defined can not print to printer."
KILL JZ1
DO ALT
QUIT
E2 WRITE !!,*7," ...Request printer not defined can not print to printer."
KILL JZ1
DO ALT
QUIT
+1 ;
DT SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)_$PIECE("@"_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12),"^",Y[".")
if Y="//"
SET Y=""
QUIT
+1 QUIT
