RAPNL ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Radiology Personnel Menu ;9/12/94 11:15
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
1 ;;Classification Edit
W ! S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Select Personnel: " D ^DIC K DIC Q:Y<0
S DA=+Y,DIE="^VA(200,",DR="[RA PERSONNEL]" D ^DIE K %,%X,%Y,C,D0,D1,DA,DE,DQ,DIE,DR G 1
;
2 ;;Technologist List
S DIC="^VA(200,",L=0,FLDS="[RA PERSONNEL LIST]",DHD="Technologist List",BY="[RA PERSONNEL LIST]",FR="@",TO="",DIS(0)="I $D(^VA(200,""ARC"",""T"",D0))" D EN1^DIP K FLDS,BY,FR,TO,DHD,ZZ Q
;
3 ;;Resident Interpreting Physician List
S DIC="^VA(200,",L=0,FLDS="[RA RESIDENT RADIOLOGIST]",BY="[RA PERSONNEL LIST]",FR="@",TO="",DIS(0)="I $D(^VA(200,""ARC"",""R"",D0))" D EN1^DIP K FLDS,BY,FR,TO,DHD,ZZ Q
;
4 ;;Staff Interpreting Physician List
S DIC="^VA(200,",L=0,FLDS="[RA PERSONNEL LIST]",DHD="Interpreting Staff List",BY="[RA PERSONNEL LIST]",FR="@",TO="",DIS(0)="I $D(^VA(200,""ARC"",""S"",D0))" D EN1^DIP K FLDS,BY,TO,FR,DHD,ZZ Q
;
5 ;;Radiology/Nuclear Medicine Clerk List
S DIC="^VA(200,",L=0,FLDS="[RA PERSONNEL LIST]"
S DHD="Radiology/Nuclear Medicine Clerk List"
S FR="@",TO="",BY="[RA PERSONNEL LIST]"
S DIS(0)="I $D(^VA(200,""ARC"",""C"",D0))"
D EN1^DIP K FLDS,BY,TO,FR,DHD,ZZ
Q
KEYS(RAD0) ; List keys for user
; Called from [RA PERSONNEL LIST] and [RA RESIDENT RADIOLOGIST]
; print templates. RAHD is used for formatting text. RAHD's value
; is printed inside the above templates.
N RAD1,RAFLG,RAHD,RAKEY,RANODE
S (RAD1,RAFLG)=0,RAHD=" Rad/Nuc Med Keys: "
F S RAD1=$O(^VA(200,RAD0,51,RAD1)) Q:RAD1'>0 D
. S RANODE=$G(^VA(200,RAD0,51,RAD1,0)) Q:RANODE']""
. S RAKEY=$$LKUP^XPDKEY(+RANODE) Q:$E(RAKEY,1,2)'="RA"
. I $X>(IOM-30) W !?($X+$L(RAHD)) S RAFLG=0
. W:RAFLG ", " W RAKEY S RAFLG=1
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPNL 1814 printed Dec 13, 2024@02:38:44 Page 2
RAPNL ;HISC/CAH,FPT,GJC AISC/MJK,RMO-Radiology Personnel Menu ;9/12/94 11:15
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
1 ;;Classification Edit
+1 WRITE !
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select Personnel: "
DO ^DIC
KILL DIC
if Y<0
QUIT
+2 SET DA=+Y
SET DIE="^VA(200,"
SET DR="[RA PERSONNEL]"
DO ^DIE
KILL %,%X,%Y,C,D0,D1,DA,DE,DQ,DIE,DR
GOTO 1
+3 ;
2 ;;Technologist List
+1 SET DIC="^VA(200,"
SET L=0
SET FLDS="[RA PERSONNEL LIST]"
SET DHD="Technologist List"
SET BY="[RA PERSONNEL LIST]"
SET FR="@"
SET TO=""
SET DIS(0)="I $D(^VA(200,""ARC"",""T"",D0))"
DO EN1^DIP
KILL FLDS,BY,FR,TO,DHD,ZZ
QUIT
+2 ;
3 ;;Resident Interpreting Physician List
+1 SET DIC="^VA(200,"
SET L=0
SET FLDS="[RA RESIDENT RADIOLOGIST]"
SET BY="[RA PERSONNEL LIST]"
SET FR="@"
SET TO=""
SET DIS(0)="I $D(^VA(200,""ARC"",""R"",D0))"
DO EN1^DIP
KILL FLDS,BY,FR,TO,DHD,ZZ
QUIT
+2 ;
4 ;;Staff Interpreting Physician List
+1 SET DIC="^VA(200,"
SET L=0
SET FLDS="[RA PERSONNEL LIST]"
SET DHD="Interpreting Staff List"
SET BY="[RA PERSONNEL LIST]"
SET FR="@"
SET TO=""
SET DIS(0)="I $D(^VA(200,""ARC"",""S"",D0))"
DO EN1^DIP
KILL FLDS,BY,TO,FR,DHD,ZZ
QUIT
+2 ;
5 ;;Radiology/Nuclear Medicine Clerk List
+1 SET DIC="^VA(200,"
SET L=0
SET FLDS="[RA PERSONNEL LIST]"
+2 SET DHD="Radiology/Nuclear Medicine Clerk List"
+3 SET FR="@"
SET TO=""
SET BY="[RA PERSONNEL LIST]"
+4 SET DIS(0)="I $D(^VA(200,""ARC"",""C"",D0))"
+5 DO EN1^DIP
KILL FLDS,BY,TO,FR,DHD,ZZ
+6 QUIT
KEYS(RAD0) ; List keys for user
+1 ; Called from [RA PERSONNEL LIST] and [RA RESIDENT RADIOLOGIST]
+2 ; print templates. RAHD is used for formatting text. RAHD's value
+3 ; is printed inside the above templates.
+4 NEW RAD1,RAFLG,RAHD,RAKEY,RANODE
+5 SET (RAD1,RAFLG)=0
SET RAHD=" Rad/Nuc Med Keys: "
+6 FOR
SET RAD1=$ORDER(^VA(200,RAD0,51,RAD1))
if RAD1'>0
QUIT
Begin DoDot:1
+7 SET RANODE=$GET(^VA(200,RAD0,51,RAD1,0))
if RANODE']""
QUIT
+8 SET RAKEY=$$LKUP^XPDKEY(+RANODE)
if $EXTRACT(RAKEY,1,2)'="RA"
QUIT
+9 IF $X>(IOM-30)
WRITE !?($X+$LENGTH(RAHD))
SET RAFLG=0
+10 if RAFLG
WRITE ", "
WRITE RAKEY
SET RAFLG=1
+11 QUIT
End DoDot:1
+12 QUIT
