source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTP.m@ 1261

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

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1RTP ;MJK/TROY ISC;Pull List Option; ; 5/7/87 12:37 PM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3 D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
4 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)
5 D IXALL^DIK
6A D OVERALL^RTPSET Q:$D(XQUIT)
7 W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
8 ;
91 ;;Create Pull List
10CREATE I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
11 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
12 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
13 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=""
14 D ADD^RTP2:'$D(Y) K DLAYGO,DIC,RTESC,RTPULL
15Q K X1,A,DA,D0,DR,DIE,P,POP,RTC,RTY,%,%I,%H
16 K DIC,X,Y,J,I Q
17 ;
182 ;;Change Pull List Date
19 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
20 S %DT="ATEFX",%DT("A")="Enter NEW Date: ",%DT(0)="NOW" D ^%DT K %DT G Q2:Y<0 S RTQDT=Y
21 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"
22 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
23 S DA=RTPULL,DR="2////"_RTQDT,DIE="^RTV(194.2," D ^DIE
24Q2 K DE,DQ,RTPULL,RTQDT,RTQ G Q
25 ;
263 ;;Add Records Request to List
27 I '$D(RTDIV) D DIV1^RTPSET I '$D(RTDIV) D MES^RTP4 Q
28 D LIST G Q:Y<0 D ADD^RTP2 K DIC,RTESC,RTPULL G Q
29 ;
304 ;;Cancel an Entire Pull List
31 D LIST G Q4:Y<0 S Y="cancel" D ASK G Q4:$E(X)'="Y" S RTSTAT="x"
32CAN 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
33 K RTQ D STAT W !!?3,"...pull list has been cancelled"
34Q4 K RTPULL,RTSTAT
35 K DUOUT,X,Y,DIC,J G Q
36 ;
375 ;;Designate Requests as Not Fillable
38 G 5^RTP1
39 ;
406 ;;Charge Out Pull List
41 G ^RTP4
42 ;
437 ;;Flag Pull List as PULLED/NOT CHARGED
44 ;D LIST Q:Y<0 S RTSTAT="p" G CAN
45 Q
46 ;
478 ;;Cancel Individual Requests from Pull List
48 G 8^RTP1
49 ;
509 ;;Modify Pull List Comments
51 G 9^RTP1
52 ;
5310 ;;Pull List Print
54 G ^RTP3
55 ;
5611 ;;Special Multi-Institution Prints
57 G ^RTP5
58 ;
5912 ;;Cancel an Entire Pull list for all future dates
60 G ALL^RTPCAN
61 ;
62LIST 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
63 ;
64STAT S DA=RTPULL,DR="[RT CHANGE PULL LIST STATUS]",DIE="^RTV(194.2," D ^DIE K DE,DQ Q
65 ;
66ASK ;
67 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
68 ;
Note: See TracBrowser for help on using the repository browser.