source: FOIAVistA/trunk/r/RECORD_TRACKING-RT/RTSM.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1RTSM ;MJK/TROY ISC;Site Manager's Menu; ; 4/21/87 2:05 PM ;
2 ;;v 2.0;Record Tracking;**7**;10/22/91
3 D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
4 G:$D(^DOPT($P(X," ;"),17)) 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 ;;Application
10 W ! S DA=+RTAPL,DIE="^DIC(195.1,",DR="[RT APPL SET-UP (SITE MGR)]" D ^DIE K DE,DQ,DA,D0,DIE,DR Q
11 ;
122 ;;File Room
13L2 D FR G Q2:Y<0 S DA=+Y,DIE="^RTV(195.9,",DR="[RT FILE ROOM SET-UP (SITE MGR)]" D ^DIE K DQ,DE G L2
14Q2 K X,Y,DA,D0,DR,DIE Q
15 ;
16FR W ! S DIC="^SC(",DIC("A")="Select File Room: ",DIC(0)="IAEMLQ",DIC("DR")="2///F",DIC("S")="I $P(^(0),U,3)=""F"",$S('$D(^RTV(195.9,""ABOR"",(Y_"";SC(""))):1,1:$D(^((Y_"";SC(""),"_+RTAPL_")))" D ^DIC K DIC Q:Y<0 D CHK^RTDPA3 Q
17 ;
183 ;;File Room/Remote Set-up (site mgr)
19 G SM^RTTR
20 ;
214 ;;[]
22 Q
23 ;
245 ;;Overall Parameters
25 W ! S DA=1,DIE="^DIC(195.4,",DR="[RT OVERALL PARAMETERS]" D ^DIE K DE,DQ,DR,DIE,DA,D0 Q
26 ;
276 ;;Admitting Area
28 D MAS Q:'Y
29L6 D AA G Q6:Y<0 S DA=+Y,DIE="^RTV(195.9,",DR="[RT ADMIT SET-UP (SITE MGR)]" D ^DIE G L6
30Q6 K DA,D0,DIE,DR Q
31 ;
32AA W ! S DIC="^SC(",DIC("A")="Select Admitting Area: ",DIC(0)="IAEMLQ",DIC("DR")="2///Z;2.1///AA"
33 S DIC("S")="I $P(^(0),U,3)=""Z"",$D(^DIC(40.9,+$P(^(0),U,22),0)),$P(^(0),U,2)=""AA""" D ^DIC K DIC Q:Y<0 D CHK^RTDPA3 Q
34 ;
357 ;;Imaging Area (Radiology)
36 D RAD Q:'Y
37L7 D RA^RTRAD G Q7:Y<0 S DA=+Y,DIE="^RTV(195.9,",DR="4" D ^DIE G L7
38Q7 K DA,D0,DIE,DQ,DR,I,C Q
39 ;
408 ;;Templates
41 S %ZIS="N",%ZIS("A")="Select Report Device: " D ^%ZIS Q:POP S RTION=ION K %ZIS
42 F RTEMP="INPUT","SORT","PRINT" S Y="RT "_RTEMP_" TEMPLATES" W !!,"Record Tracking's ",RTEMP," Templates: " S (BY,FLDS)="["_Y_"]",L=0,DIC=$S(RTEMP="PRINT":"^DIPT(",RTEMP="SORT":"^DIBT(",1:"^DIE("),IOP="Q;"_RTION K DTOUT D EN1^DIP K BY,FLDS,L
43 K IOP,RTION Q
44 ;
459 ;;Initialize Records
46 G 9^RTSM3
47 ;
4810 ;;Patient Labels
49 G 10^RTSM3
50 ;
5111 ;;In-Patient Labels
52 G 11^RTSM3
53 ;
5412 ;;Create Terminal Digit Sort Global
55 G 12^RTSM1
56 ;
5713 ;;Delete Terminal Digit Sort Global
58 G 13^RTSM1
59 ;
6014 ;;Initialize Borrowers
61 S RTA=+RTAPL S Y="CLINICS" D ASK G Q14:RTASK="^"
62 I RTASK="Y" F RTI=0:0 S RTI=$O(^SC(RTI)) Q:'RTI I $D(^SC(RTI,0)),$P(^(0),"^",3)="C",$S('$D(^("I")):1,'^("I"):1,DT<+^("I"):1,'$P(^("I"),"^",2):0,DT>+$P(^("I"),"^",2):1,1:0) S RTB=RTI_";SC(" D RTB
63 W:RTASK="Y" "...Done" S Y="WARDS" D ASK G Q14:RTASK="^"
64 I RTASK="Y" F RTI=0:0 S RTI=$O(^DIC(42,RTI)) Q:'RTI I $D(^DIC(42,RTI,0)) N D0,X S D0=RTI D WIN^DGPMDDCF I 'X S RTB=RTI_";DIC(42," D RTB
65 W:RTASK="Y" "...Done" S Y="PROVIDERS" D ASK G Q14:RTASK'="Y" W !!,"OK. This may take awhile..."
66 F RTI=0:0 S RTI=$O(^VA(200,RTI)) Q:'RTI I $D(^VA(200,RTI,0)),$S('$D(^("I")):1,'^("I"):1,^("I")>DT:1,1:0) S RTB=RTI_";VA(200," D RTB
67Q14 W:RTASK="Y" "...Done" K RTASK,RTI,RTB,RTA
68 K X1,Y,X,I,J Q
69ASK S RTRD(1)="Yes^initialize/update "_Y_" as borrowers",RTRD(2)="No^not initialize/update "_Y_" as borrowers",RTRD("B")=2,RTRD(0)="S",RTRD("A")="Initialize active '"_Y_"' as "_$P($P(RTAPL,"^"),";",2)_" borrowers? "
70 D SET^RTRD K RTRD S RTASK=$E(X) Q
71 ;
72RTB S Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y W "." Q
73 ;
7415 ;;Re-compile
75 G BOTH^RTUTL5
76 ;
7716 ;;Clinic Request Init
78 G 16^RTSM4
79 ;
8017 ;;Purge Data
81 G ^RTPURGE
82 ;
8318 ;;1 Clinic Request Init
84 G 18^RTSM5
85 ;
8619 ;;Dailey Clinic Request Init
87 G 19^RTSM6
88 ;
89MAS S Y=1 I $S('$D(^DIC(195.4,1,"MAS")):1,+^("MAS")'=+RTAPL:1,1:0) W !!?3,*7,"Current application is not the 'Medical Records' application." S Y=0
90 Q
91 ;
92RAD S Y=1 I $S('$D(^DIC(195.4,1,"RAD")):1,+^("RAD")'=+RTAPL:1,1:0) W !!?3,*7,"Current application is not the 'Film Tracking' application." S Y=0
93 Q
94 ;
95BOTH K RADPT I $D(^DIC(195.4,1,"MAS")),+^("MAS")=+RTAPL S RADPT=0 Q
96 I $D(^DIC(195.4,1,"RAD")),+^("RAD")=+RTAPL S RADPT=1 Q
97 W !!?3,*7,"Current application is not the 'Film Tracking' nor the"
98 W !?3,"'Medical Records' application." Q
Note: See TracBrowser for help on using the repository browser.