RTSM ;MJK/TROY ISC;Site Manager's Menu; ; 4/21/87 2:05 PM ;
;;v 2.0;Record Tracking;**7**;10/22/91
D DT^DICRW S X=$T(+1),DIK="^DOPT("""_$P(X," ;",1)_""","
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)
D IXALL^DIK
A D OVERALL^RTPSET Q:$D(XQUIT)
W !! S DIC="^DOPT("""_$P($T(+1)," ;")_""",",DIC(0)="IQEAM" D ^DIC Q:Y<0 D @+Y G A
;
1 ;;Application
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
;
2 ;;File Room
L2 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
Q2 K X,Y,DA,D0,DR,DIE Q
;
FR 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
;
3 ;;File Room/Remote Set-up (site mgr)
G SM^RTTR
;
4 ;;[]
Q
;
5 ;;Overall Parameters
W ! S DA=1,DIE="^DIC(195.4,",DR="[RT OVERALL PARAMETERS]" D ^DIE K DE,DQ,DR,DIE,DA,D0 Q
;
6 ;;Admitting Area
D MAS Q:'Y
L6 D AA G Q6:Y<0 S DA=+Y,DIE="^RTV(195.9,",DR="[RT ADMIT SET-UP (SITE MGR)]" D ^DIE G L6
Q6 K DA,D0,DIE,DR Q
;
AA W ! S DIC="^SC(",DIC("A")="Select Admitting Area: ",DIC(0)="IAEMLQ",DIC("DR")="2///Z;2.1///AA"
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
;
7 ;;Imaging Area (Radiology)
D RAD Q:'Y
L7 D RA^RTRAD G Q7:Y<0 S DA=+Y,DIE="^RTV(195.9,",DR="4" D ^DIE G L7
Q7 K DA,D0,DIE,DQ,DR,I,C Q
;
8 ;;Templates
S %ZIS="N",%ZIS("A")="Select Report Device: " D ^%ZIS Q:POP S RTION=ION K %ZIS
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
K IOP,RTION Q
;
9 ;;Initialize Records
G 9^RTSM3
;
10 ;;Patient Labels
G 10^RTSM3
;
11 ;;In-Patient Labels
G 11^RTSM3
;
12 ;;Create Terminal Digit Sort Global
G 12^RTSM1
;
13 ;;Delete Terminal Digit Sort Global
G 13^RTSM1
;
14 ;;Initialize Borrowers
S RTA=+RTAPL S Y="CLINICS" D ASK G Q14:RTASK="^"
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
W:RTASK="Y" "...Done" S Y="WARDS" D ASK G Q14:RTASK="^"
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
W:RTASK="Y" "...Done" S Y="PROVIDERS" D ASK G Q14:RTASK'="Y" W !!,"OK. This may take awhile..."
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
Q14 W:RTASK="Y" "...Done" K RTASK,RTI,RTB,RTA
K X1,Y,X,I,J Q
ASK 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? "
D SET^RTRD K RTRD S RTASK=$E(X) Q
;
RTB S Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y W "." Q
;
15 ;;Re-compile
G BOTH^RTUTL5
;
16 ;;Clinic Request Init
G 16^RTSM4
;
17 ;;Purge Data
G ^RTPURGE
;
18 ;;1 Clinic Request Init
G 18^RTSM5
;
19 ;;Dailey Clinic Request Init
G 19^RTSM6
;
MAS 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
Q
;
RAD 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
Q
;
BOTH K RADPT I $D(^DIC(195.4,1,"MAS")),+^("MAS")=+RTAPL S RADPT=0 Q
I $D(^DIC(195.4,1,"RAD")),+^("RAD")=+RTAPL S RADPT=1 Q
W !!?3,*7,"Current application is not the 'Film Tracking' nor the"
W !?3,"'Medical Records' application." Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTSM 4092 printed Dec 13, 2024@02:34:42 Page 2
RTSM ;MJK/TROY ISC;Site Manager's Menu; ; 4/21/87 2:05 PM ;
+1 ;;v 2.0;Record Tracking;**7**;10/22/91
+2 DO DT^DICRW
SET X=$TEXT(+1)
SET DIK="^DOPT("""_$PIECE(X," ;",1)_""","
+3 if $DATA(^DOPT($PIECE(X," ;"),17))
GOTO A
SET ^DOPT($PIECE(X," ;"),0)=$PIECE(X,";",3)_"^1N^"
FOR I=1:1
SET Y=$TEXT(@I)
if Y=""
QUIT
SET ^DOPT($PIECE(X," ;"),I,0)=$PIECE(Y,";",3,99)
+4 DO IXALL^DIK
A DO OVERALL^RTPSET
if $DATA(XQUIT)
QUIT
+1 WRITE !!
SET DIC="^DOPT("""_$PIECE($TEXT(+1)," ;")_""","
SET DIC(0)="IQEAM"
DO ^DIC
if Y<0
QUIT
DO @+Y
GOTO A
+2 ;
1 ;;Application
+1 WRITE !
SET DA=+RTAPL
SET DIE="^DIC(195.1,"
SET DR="[RT APPL SET-UP (SITE MGR)]"
DO ^DIE
KILL DE,DQ,DA,D0,DIE,DR
QUIT
+2 ;
2 ;;File Room
L2 DO FR
if Y<0
GOTO Q2
SET DA=+Y
SET DIE="^RTV(195.9,"
SET DR="[RT FILE ROOM SET-UP (SITE MGR)]"
DO ^DIE
KILL DQ,DE
GOTO L2
Q2 KILL X,Y,DA,D0,DR,DIE
QUIT
+1 ;
FR WRITE !
SET DIC="^SC("
SET DIC("A")="Select File Room: "
SET DIC(0)="IAEMLQ"
SET DIC("DR")="2///F"
SET DIC("S")="I $P(^(0),U,3)=""F"",$S('$D(^RTV(195.9,""ABOR"",(Y_"";SC(""))):1,1:$D(^((Y_"";SC(""),"_+RTAPL_")))"
DO ^DIC
KILL DIC
if Y<0
QUIT
DO CHK^RTDPA3
QUIT
+1 ;
3 ;;File Room/Remote Set-up (site mgr)
+1 GOTO SM^RTTR
+2 ;
4 ;;[]
+1 QUIT
+2 ;
5 ;;Overall Parameters
+1 WRITE !
SET DA=1
SET DIE="^DIC(195.4,"
SET DR="[RT OVERALL PARAMETERS]"
DO ^DIE
KILL DE,DQ,DR,DIE,DA,D0
QUIT
+2 ;
6 ;;Admitting Area
+1 DO MAS
if 'Y
QUIT
L6 DO AA
if Y<0
GOTO Q6
SET DA=+Y
SET DIE="^RTV(195.9,"
SET DR="[RT ADMIT SET-UP (SITE MGR)]"
DO ^DIE
GOTO L6
Q6 KILL DA,D0,DIE,DR
QUIT
+1 ;
AA WRITE !
SET DIC="^SC("
SET DIC("A")="Select Admitting Area: "
SET DIC(0)="IAEMLQ"
SET DIC("DR")="2///Z;2.1///AA"
+1 SET DIC("S")="I $P(^(0),U,3)=""Z"",$D(^DIC(40.9,+$P(^(0),U,22),0)),$P(^(0),U,2)=""AA"""
DO ^DIC
KILL DIC
if Y<0
QUIT
DO CHK^RTDPA3
QUIT
+2 ;
7 ;;Imaging Area (Radiology)
+1 DO RAD
if 'Y
QUIT
L7 DO RA^RTRAD
if Y<0
GOTO Q7
SET DA=+Y
SET DIE="^RTV(195.9,"
SET DR="4"
DO ^DIE
GOTO L7
Q7 KILL DA,D0,DIE,DQ,DR,I,C
QUIT
+1 ;
8 ;;Templates
+1 SET %ZIS="N"
SET %ZIS("A")="Select Report Device: "
DO ^%ZIS
if POP
QUIT
SET RTION=ION
KILL %ZIS
+2 FOR RTEMP="INPUT","SORT","PRINT"
SET Y="RT "_RTEMP_" TEMPLATES"
WRITE !!,"Record Tracking's ",RTEMP," Templates: "
SET (BY,FLDS)="["_Y_"]"
SET L=0
SET DIC=$SELECT(RTEMP="PRINT":"^DIPT(",RTEMP="SORT":"^DIBT(",1:"^DIE(")
SET IOP="Q;"_RTION
KILL DTOUT
DO EN1^DIP
KILL BY,FLDS,L
+3 KILL IOP,RTION
QUIT
+4 ;
9 ;;Initialize Records
+1 GOTO 9^RTSM3
+2 ;
10 ;;Patient Labels
+1 GOTO 10^RTSM3
+2 ;
11 ;;In-Patient Labels
+1 GOTO 11^RTSM3
+2 ;
12 ;;Create Terminal Digit Sort Global
+1 GOTO 12^RTSM1
+2 ;
13 ;;Delete Terminal Digit Sort Global
+1 GOTO 13^RTSM1
+2 ;
14 ;;Initialize Borrowers
+1 SET RTA=+RTAPL
SET Y="CLINICS"
DO ASK
if RTASK="^"
GOTO Q14
+2 IF RTASK="Y"
FOR RTI=0:0
SET RTI=$ORDER(^SC(RTI))
if 'RTI
QUIT
IF $DATA(^SC(RTI,0))
IF $PIECE(^(0),"^",3)="C"
IF $SELECT('$DATA(^("I")):1,'^("I"):1,DT<+^("I"):1,'$PIECE(^("I"),"^",2):0,DT>+$PIECE(^("I"),"^",2):1,1:0)
SET RTB=RTI_";SC("
DO RTB
+3 if RTASK="Y"
WRITE "...Done"
SET Y="WARDS"
DO ASK
if RTASK="^"
GOTO Q14
+4 IF RTASK="Y"
FOR RTI=0:0
SET RTI=$ORDER(^DIC(42,RTI))
if 'RTI
QUIT
IF $DATA(^DIC(42,RTI,0))
NEW D0,X
SET D0=RTI
DO WIN^DGPMDDCF
IF 'X
SET RTB=RTI_";DIC(42,"
DO RTB
+5 if RTASK="Y"
WRITE "...Done"
SET Y="PROVIDERS"
DO ASK
if RTASK'="Y"
GOTO Q14
WRITE !!,"OK. This may take awhile..."
+6 FOR RTI=0:0
SET RTI=$ORDER(^VA(200,RTI))
if 'RTI
QUIT
IF $DATA(^VA(200,RTI,0))
IF $SELECT('$DATA(^("I")):1,'^("I"):1,^("I")>DT:1,1:0)
SET RTB=RTI_";VA(200,"
DO RTB
Q14 if RTASK="Y"
WRITE "...Done"
KILL RTASK,RTI,RTB,RTA
+1 KILL X1,Y,X,I,J
QUIT
ASK SET RTRD(1)="Yes^initialize/update "_Y_" as borrowers"
SET RTRD(2)="No^not initialize/update "_Y_" as borrowers"
SET RTRD("B")=2
SET RTRD(0)="S"
SET RTRD("A")="Initialize active '"_Y_"' as "_$PIECE($PIECE(RTAPL,"^"),";",2)_" borrowers? "
+1 DO SET^RTRD
KILL RTRD
SET RTASK=$EXTRACT(X)
QUIT
+2 ;
RTB SET Y=+$ORDER(^RTV(195.9,"ABOR",RTB,RTA,0))
if 'Y
DO SET^RTDPA3
WRITE "."
QUIT
+1 ;
15 ;;Re-compile
+1 GOTO BOTH^RTUTL5
+2 ;
16 ;;Clinic Request Init
+1 GOTO 16^RTSM4
+2 ;
17 ;;Purge Data
+1 GOTO ^RTPURGE
+2 ;
18 ;;1 Clinic Request Init
+1 GOTO 18^RTSM5
+2 ;
19 ;;Dailey Clinic Request Init
+1 GOTO 19^RTSM6
+2 ;
MAS SET Y=1
IF $SELECT('$DATA(^DIC(195.4,1,"MAS")):1,+^("MAS")'=+RTAPL:1,1:0)
WRITE !!?3,*7,"Current application is not the 'Medical Records' application."
SET Y=0
+1 QUIT
+2 ;
RAD SET Y=1
IF $SELECT('$DATA(^DIC(195.4,1,"RAD")):1,+^("RAD")'=+RTAPL:1,1:0)
WRITE !!?3,*7,"Current application is not the 'Film Tracking' application."
SET Y=0
+1 QUIT
+2 ;
BOTH KILL RADPT
IF $DATA(^DIC(195.4,1,"MAS"))
IF +^("MAS")=+RTAPL
SET RADPT=0
QUIT
+1 IF $DATA(^DIC(195.4,1,"RAD"))
IF +^("RAD")=+RTAPL
SET RADPT=1
QUIT
+2 WRITE !!?3,*7,"Current application is not the 'Film Tracking' nor the"
+3 WRITE !?3,"'Medical Records' application."
QUIT
