- RTQ41 ;MJK/TROY ISC;Record Request Option; ; 5/5/87 8:42 AM ;
- ;;v 2.0;Record Tracking;;10/22/91
- 3 ;Cancel a Request
- S RTPGM="CANCEL"
- 31 I '$D(RTAPL) D APL2^RTPSET D NEXT3:$D(RTAPL) K RTAPL,RTSYS Q
- NEXT3 D PND^RTRPT
- L3 K RTY S RTSEL="S",DIC(0)="IAEMQ",DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"") D SCRN^RTQ"
- D ^RTDPA2 K RT,RTSEL,RTE,RTQ D:$D(RTY) @RTPGM
- Q3 K RTY,RTPGM,RTWND,RTSEL,RTESC
- K I,%DT,D0,DA,DIE,N,RTC,X1,X,Y,DR,DIC,J Q
- 5 ;;Reprint a Request
- S RTPGM="REPRT" G 31
- ;
- REPRT S RTION="" F RTY=0:0 S RTY=$O(RTY(RTY)) Q:'RTY S RTQ=+RTY(RTY) D RTQ^RTL1
- K RTION,RTQ Q
- ;
- CANCEL S RTRD(1)="Yes^cancel",RTRD(2)="No^not cancel",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Are you sure you want to cancel "_$S(RTC=1:"this request",1:"these requests")_"? " D SET^RTRD K RTRD G CANCELQ:$E(X)'="Y"
- S RTSTAT="x" F RTY=0:0 S RTY=$O(RTY(RTY)) Q:'RTY S DA=+RTY(RTY),DIE="^RTV(190.1,",DR="[RT CHANGE REQUEST STATUS]" D ^DIE,BUL^RTUTL6 K DE,DQ W !?3,"...request #",DA," has been cancelled."
- CANCELQ K RTSTAT Q
- ;
- ;
- FILL ;Entry pt with RTQ defined ;if rtplty=3
- S X="TRANSFER RETIRE" D TYPE^RTT Q:'$D(RTMV)!('$D(^RTV(190.1,RTQ,0))) S RT=+^(0),RTSTAT="c",RTB=^TMP($J,"RTREQUESTS","RTB")
- ;S RTB=+$P(Y,"^",5),RT=+Y,RTPROV=+$P(Y,"^",14)
- S RTINACFL=1
- I $S('$D(^RT(RT,"CL")):1,'$D(^RTV(195.9,+$P(^("CL"),"^",5),0)):1,$P(^(0),"^")="2;DIC(195.4,":0,1:1) D CHG^RTT I '$D(Y) S DIE="^RTV(190.1,",DR="[RT CHANGE REQUEST STATUS]",DA=RTQ D ^DIE
- K DE,DQ,RTSTAT,RTMV,RTMV0,RTPROV,RT Q
- ;
- PERP ;create appl default perpetual records from rr pull list
- I '$D(^TMP($J,"RTE")) Q
- I $D(^DIC(195.1,+RTAPL,4)),$P(^(4),"^",5) S RTRTY=$P(^(4),"^",5)
- E Q
- S RTCOUNT=0
- S Y=RTRTY,C=$P(^DD(195.1,45,0),"^",2) D Y^DIQ S RTCOUNT("TY")=Y
- W !!,"Creating '",Y,"' records from RR Pull lists charged out",!!
- ;log record creation, print labels
- K RTBKGRD S RTADM=""
- S RTRE=0 F N=0:0 S RTRE=$O(^TMP($J,"RTE",RTRE)) Q:'RTRE S RTE=RTRE,RTTY=+RTRTY,RTVOL=1,RTPAR="" I '$D(^RT("AT",RTTY,RTE)) D SET^RTDPA1 S RTCOUNT=RTCOUNT+1
- W !!," Total '",RTCOUNT("TY"),"' records created = ",RTCOUNT,!!
- K RTADM,RTCOUNT,RTRE,RTRTY,RTE,RTTY,RTVOL,RTPAR Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTQ41 2155 printed Feb 19, 2025@00:01:02 Page 2
- RTQ41 ;MJK/TROY ISC;Record Request Option; ; 5/5/87 8:42 AM ;
- +1 ;;v 2.0;Record Tracking;;10/22/91
- 3 ;Cancel a Request
- +1 SET RTPGM="CANCEL"
- 31 IF '$DATA(RTAPL)
- DO APL2^RTPSET
- if $DATA(RTAPL)
- DO NEXT3
- KILL RTAPL,RTSYS
- QUIT
- NEXT3 DO PND^RTRPT
- L3 KILL RTY
- SET RTSEL="S"
- SET DIC(0)="IAEMQ"
- SET DIC("S")="S Z=^(0) I $P(Z,U,6)=""r""!($P(Z,U,6)=""n"") D SCRN^RTQ"
- +1 DO ^RTDPA2
- KILL RT,RTSEL,RTE,RTQ
- if $DATA(RTY)
- DO @RTPGM
- Q3 KILL RTY,RTPGM,RTWND,RTSEL,RTESC
- +1 KILL I,%DT,D0,DA,DIE,N,RTC,X1,X,Y,DR,DIC,J
- QUIT
- 5 ;;Reprint a Request
- +1 SET RTPGM="REPRT"
- GOTO 31
- +2 ;
- REPRT SET RTION=""
- FOR RTY=0:0
- SET RTY=$ORDER(RTY(RTY))
- if 'RTY
- QUIT
- SET RTQ=+RTY(RTY)
- DO RTQ^RTL1
- +1 KILL RTION,RTQ
- QUIT
- +2 ;
- CANCEL SET RTRD(1)="Yes^cancel"
- SET RTRD(2)="No^not cancel"
- SET RTRD("B")=2
- SET RTRD(0)="S"
- SET RTRD("A")="Are you sure you want to cancel "_$SELECT(RTC=1:"this request",1:"these requests")_"? "
- DO SET^RTRD
- KILL RTRD
- if $EXTRACT(X)'="Y"
- GOTO CANCELQ
- +1 SET RTSTAT="x"
- FOR RTY=0:0
- SET RTY=$ORDER(RTY(RTY))
- if 'RTY
- QUIT
- SET DA=+RTY(RTY)
- SET DIE="^RTV(190.1,"
- SET DR="[RT CHANGE REQUEST STATUS]"
- DO ^DIE
- DO BUL^RTUTL6
- KILL DE,DQ
- WRITE !?3,"...request #",DA," has been cancelled."
- CANCELQ KILL RTSTAT
- QUIT
- +1 ;
- +2 ;
- FILL ;Entry pt with RTQ defined ;if rtplty=3
- +1 SET X="TRANSFER RETIRE"
- DO TYPE^RTT
- if '$DATA(RTMV)!('$DATA(^RTV(190.1,RTQ,0)))
- QUIT
- SET RT=+^(0)
- SET RTSTAT="c"
- SET RTB=^TMP($JOB,"RTREQUESTS","RTB")
- +2 ;S RTB=+$P(Y,"^",5),RT=+Y,RTPROV=+$P(Y,"^",14)
- +3 SET RTINACFL=1
- +4 IF $SELECT('$DATA(^RT(RT,"CL")):1,'$DATA(^RTV(195.9,+$PIECE(^("CL"),"^",5),0)):1,$PIECE(^(0),"^")="2;DIC(195.4,":0,1:1)
- DO CHG^RTT
- IF '$DATA(Y)
- SET DIE="^RTV(190.1,"
- SET DR="[RT CHANGE REQUEST STATUS]"
- SET DA=RTQ
- DO ^DIE
- +5 KILL DE,DQ,RTSTAT,RTMV,RTMV0,RTPROV,RT
- QUIT
- +6 ;
- PERP ;create appl default perpetual records from rr pull list
- +1 IF '$DATA(^TMP($JOB,"RTE"))
- QUIT
- +2 IF $DATA(^DIC(195.1,+RTAPL,4))
- IF $PIECE(^(4),"^",5)
- SET RTRTY=$PIECE(^(4),"^",5)
- +3 IF '$TEST
- QUIT
- +4 SET RTCOUNT=0
- +5 SET Y=RTRTY
- SET C=$PIECE(^DD(195.1,45,0),"^",2)
- DO Y^DIQ
- SET RTCOUNT("TY")=Y
- +6 WRITE !!,"Creating '",Y,"' records from RR Pull lists charged out",!!
- +7 ;log record creation, print labels
- +8 KILL RTBKGRD
- SET RTADM=""
- +9 SET RTRE=0
- FOR N=0:0
- SET RTRE=$ORDER(^TMP($JOB,"RTE",RTRE))
- if 'RTRE
- QUIT
- SET RTE=RTRE
- SET RTTY=+RTRTY
- SET RTVOL=1
- SET RTPAR=""
- IF '$DATA(^RT("AT",RTTY,RTE))
- DO SET^RTDPA1
- SET RTCOUNT=RTCOUNT+1
- +10 WRITE !!," Total '",RTCOUNT("TY"),"' records created = ",RTCOUNT,!!
- +11 KILL RTADM,RTCOUNT,RTRE,RTRTY,RTE,RTTY,RTVOL,RTPAR
- QUIT
