Routine: RAPNL

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAPNL   1814     printed  Feb 19, 2025@00:05                                                                                                                                                                                                          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

RAPNL.m