- 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 Jan 18, 2025@03:35:52 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