- 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 Jan 18, 2025@03:36:20 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