Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RTP

RTP.m

Go to the documentation of this file.
  1. RTP ;MJK/TROY ISC;Pull List Option; ; 5/7/87 12:37 PM ;
  1. ;;v 2.0;Record Tracking;;10/22/91
  1. D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
  1. G:$D(^DOPT($P(X," ;"),11)) A S ^DOPT($P(X," ;"),0)=$P(X,";",3)_"^1N^" F I=1:1 S Y=$T(@I) Q:Y="" S ^DOPT($P(X," ;"),I,0)=$P(Y,";",3,99)
  1. D IXALL^DIK
  1. A D OVERALL^RTPSET Q:$D(XQUIT)
  1. W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
  1. ;
  1. 1 ;;Create Pull List
  1. CREATE I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
  1. W ! S DIC("A")="Enter NEW PULL LIST NAME: ",DIC(0)="IAELQ",DIC("S")="I 0",DIC("DR")="15////"_+RTAPL,DIC="^RTV(194.2,",DLAYGO=194.2 D ^DIC K DIC G Q:Y<0
  1. K RTQDT,RTB,RTINST,RTSEL S RTPLTY=2,RTSHOW="",DIE("NO^")="OUTOK",(DA,RTPULL)=+Y,DR="[RT PULL LIST]",DIE="^RTV(194.2," D ^DIE K RTSHOW,RTINST,RTPLTY,DIE,DE,DQ
  1. I $D(Y) W !?3,*7,"...entry is incomplete" S DIK="^RTV(194.2," D ^DIK K DIK W "...pull list has been deleted." S Y=""
  1. D ADD^RTP2:'$D(Y) K DLAYGO,DIC,RTESC,RTPULL
  1. Q K X1,A,DA,D0,DR,DIE,P,POP,RTC,RTY,%,%I,%H
  1. K DIC,X,Y,J,I Q
  1. ;
  1. 2 ;;Change Pull List Date
  1. W ! S DIC("S")="I $P(^(0),U,6)=""r"",'$P(^(0),U,13),$P(^(0),U,15)=+RTAPL",DIC(0)="IAEMQ",DIC="^RTV(194.2," D ^DIC K DIC Q:Y<0 S RTPULL=+Y
  1. S %DT="ATEFX",%DT("A")="Enter NEW Date: ",%DT(0)="NOW" D ^%DT K %DT G Q2:Y<0 S RTQDT=Y
  1. S RTRD(1)="Yes^change the date",RTRD(2)="No^do not change the date",RTRD(0)="S",RTRD("B")=2,RTRD("A")="Are you sure you want to change the date the records are needed? " D SET^RTRD K RTRD G Q2:$E(X)'="Y"
  1. F RTQ=0:0 S RTQ=$O(^RTV(190.1,"AP",RTPULL,RTQ)) Q:'RTQ I $D(^RTV(190.1,RTQ,0)),$P(^(0),"^",6)="r" W "." S DA=RTQ,DR="4////"_RTQDT S DIE="^RTV(190.1," D ^DIE K DE,DQ
  1. S DA=RTPULL,DR="2////"_RTQDT,DIE="^RTV(194.2," D ^DIE
  1. Q2 K DE,DQ,RTPULL,RTQDT,RTQ G Q
  1. ;
  1. 3 ;;Add Records Request to List
  1. I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
  1. D LIST G Q:Y<0 D ADD^RTP2 K DIC,RTESC,RTPULL G Q
  1. ;
  1. 4 ;;Cancel an Entire Pull List
  1. D LIST G Q4:Y<0 S Y="cancel" D ASK G Q4:$E(X)'="Y" S RTSTAT="x"
  1. CAN F RTQ=0:0 S RTQ=$O(^RTV(190.1,"AP",RTPULL,RTQ)) Q:'RTQ I $D(^RTV(190.1,RTQ,0)),$P(^(0),"^",6)="r"!($P(^(0),"^",6)="n") S DA=RTQ,DIE="^RTV(190.1,",DR="[RT CHANGE REQUEST STATUS]" D ^DIE K DE,DQ
  1. K RTQ D STAT W !!?3,"...pull list has been cancelled"
  1. Q4 K RTPULL,RTSTAT
  1. K DUOUT,X,Y,DIC,J G Q
  1. ;
  1. 5 ;;Designate Requests as Not Fillable
  1. G 5^RTP1
  1. ;
  1. 6 ;;Charge Out Pull List
  1. G ^RTP4
  1. ;
  1. 7 ;;Flag Pull List as PULLED/NOT CHARGED
  1. ;D LIST Q:Y<0 S RTSTAT="p" G CAN
  1. Q
  1. ;
  1. 8 ;;Cancel Individual Requests from Pull List
  1. G 8^RTP1
  1. ;
  1. 9 ;;Modify Pull List Comments
  1. G 9^RTP1
  1. ;
  1. 10 ;;Pull List Print
  1. G ^RTP3
  1. ;
  1. 11 ;;Special Multi-Institution Prints
  1. G ^RTP5
  1. ;
  1. 12 ;;Cancel an Entire Pull list for all future dates
  1. G ALL^RTPCAN
  1. ;
  1. LIST W ! S DIC("S")="I $P(^(0),U,2)'<DT,$P(^(0),U,6)=""r"",$P(^(0),U,15)=+RTAPL",DIC(0)="IAEMQ",DIC="^RTV(194.2," D ^DIC K DIC Q:Y<0 S RTPULL=+Y Q
  1. ;
  1. STAT S DA=RTPULL,DR="[RT CHANGE PULL LIST STATUS]",DIE="^RTV(194.2," D ^DIE K DE,DQ Q
  1. ;
  1. ASK ;
  1. S RTRD(1)="Yes^"_Y_" entire pull list",RTRD(2)="No^not "_Y_" pull list",RTRD("B")=2,RTRD("A")="Are you sure you want to "_Y_" this pull list? ",RTRD(0)="S" D SET^RTRD K RTRD Q
  1. ;