- RMPOLZB ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
- ;;3.0;PROSTHETICS;**29,55,159**;Feb 09, 1996;Build 2
- ;
- ; ODJ - patch 55 - 1/29/01 - remove hard code 121 mail code and
- ; replace with extrinsic (AUG-1097-32118)
- ;
- ; Input:
- ;
- ; JOB - 0: interactive, 1: job
- ; RMPOLCD - Letter type code
- ;
- ; Output: None
- ;
- ; Called by:
- ; EN03^RMPOLT,EN02^RMPOLY
- N REC,POS
- ; if interactive select device
- I 'JOB D FULL^VALM1 Q:'$$DEV
- ; if print queued
- I $D(IO("Q")) D Q:'$$QUEUE^RMPOLET1(ZTDESC,ZTRTN,.ZTSAVE) D HOME^%ZIS,EXIT Q
- . K ZTSAVE
- . S ZTDESC="RMPO : Patient Letter Print",ZTRTN="START^RMPOLZB"
- . S (ZTSAVE("RMPOXITE"),ZTSAVE("JOB"),ZTSAVE("RMPOLCD"),ZTSAVE("RMPOSITE"),ZTSAVE("RMPO("),ZTSAVE("^TMP($J,RMPOXITE,"))=""
- W !,"Printing...."
- ;
- START ; Print H.O. correspondence for selected letter type
- N DATE U IO
- S Y=DT X ^DD("DD") S DATE=Y
- D HDRL ; initialise header lines
- S RMPONAM="" F S RMPONAM=$O(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM="" D
- . S RMPOLTR=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
- . S RMPODFN=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
- . S REC=^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN) D BODY
- D EXIT Q
- ;
- ONE ;print a single patient
- ;I 'JOB D FULL^VALM1 Q:'$$DEV
- ;D COMMON("PIKSOM") D ^%ZISC D CLEAN^VALM10,INIT^RMPOLT,RE^VALM4 K DIR,RTN
- D PIKSOM Q:$$QUIT I Y="" S VALMBCK="R" Q
- S LFNS=Y I 'JOB D FULL^VALM1 Q:'$$DEV
- I $D(IO("Q")) D D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 2 D HOME^%ZIS,EXIT Q
- . K ZTSAVE
- . S ZTDESC="RMPO : Patient Letter Print",ZTRTN="QUED^RMPOLZB"
- . S (ZTSAVE("RMPOXITE"),ZTSAVE("JOB"),ZTSAVE("RMPOLCD"))=""
- . S ZTSAVE("RMPOSITE")="",ZTSAVE("RMPO(")="",ZTSAVE("^TMP($J,RMPOXITE,")="",ZTSAVE("IO")="",ZTSAVE("LFNS")=""
- W !!,"Printing...."
- ;
- QUED N DATE S Y=DT X ^DD("DD") S DATE=Y D HDRL
- U IO F ZI=1:1:$L(LFNS,",")-1 D
- . S LFN=$P(LFNS,",",ZI) Q:LFN'>0
- . S RMPONAM="",CNT=0 F S RMPONAM=$O(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM="" D
- .. S RMPOLTR=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
- .. S RMPODFN=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
- .. S CNT=CNT+1
- .. S:CNT=LFN ^TMP($J,RMPOXITE,"LTR",RMPONAM)=RMPODFN
- S RMPONAM="" F S RMPONAM=$O(^TMP($J,RMPOXITE,"LTR",RMPONAM)) Q:RMPONAM="" D SINGLE
- K LFNS,LFN,ZI,RTN,DIR,RMLET
- D ^%ZISC D CLEAN^VALM10,INIT^RMPOLT,RE^VALM4
- S VALMBCK="R" D EXIT Q
- ;
- SINGLE S RMPOLTR=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
- S RMPODFN=$P(^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
- S REC=^TMP($J,RMPOXITE,"RMPODEMO",RMPODFN)
- D BODY Q
- BODY ; Set up array for filing and print letter
- N I,LN,LNCT,SP,HDR,X,Y,NAME,SURNM,FRSTNM
- S $P(SP," ",80)=" ",LNCT=0
- ;
- ; Print text or blank lines in header
- S HDR=^TMP($J,RMPOXITE,"HEADER",RMPOLTR)
- I 'HDR F I=1:1:9 D LINE("")
- I HDR D PHDR
- ;
- D LINE(DATE),LINE("")
- S NAME=$P(REC,U),SURNM=$P(NAME,",",2),FRSTNM=$P(NAME,",")
- S LN=$E(FRSTNM_" "_SURNM_SP,1,40)_"In Reply Refer To: "_RMPO("NAME")_"/"_$$ROU^RMPRUTIL(RMPOXITE)
- D LINE(LN)
- S LN=$P(REC,U,10),LN=$E(LN_SP,1,40)
- D LINE(LN)
- S LN=$P(REC,U,11) I LN]"" S LN=$E(LN_SP,1,40) D LINE(LN)
- I $P(REC,U,12)]"" D LINE($P(REC,U,12))
- ;
- ; City, State, Zip
- D LINE($P(REC,U,13)_", "_$P(REC,U,14)_" "_$P(REC,U,15))
- ;I $P(REC,U,11)="",$P(REC,U,12)="" D LINE($E(SP,1,40)_$P(RMPODFN,U))
- S RMPORX=$P(REC,U,6) S:RMPORX="" RMPORX="Not on file"
- D LINE($E(SP,1,40)_FRSTNM_" "_SURNM)
- D LINE($E(SP,1,40)_"Current Home Oxygen Rx#: "_RMPORX)
- S LN=$E(SP,1,40)_"Rx Expiration Date: "
- S RMPORXDT=$P(REC,U,4)
- I RMPORXDT="" S RMPORXDT="n/a"
- E S Y=RMPORXDT X ^DD("DD") S RMPORXDT=Y
- D LINE(LN_RMPORXDT),LINE("")
- D LINE("Dear "_$S($P(REC,U,9)="F":"Ms. ",1:"Mr. ")_SURNM_":")
- D LINE(""),LINE("")
- ;
- ; print letter template
- S I=0 F S I=$O(^RMPR(665.2,RMPOLTR,1,I)) Q:'I D LINE(^(I,0))
- ;
- ; Update Correspondence Tracking
- ; DO NOT remove patient from list is correspondence update unsuccessful.
- S X=$$FILE^RMPOLZU(RMPODFN,"^TMP("_$J_","_RMPOXITE_",""LINE"")",RMPOLTR)
- I +X D Q ; quit if error
- . W !!!,"<<< Error"_+X_":"_$P(X,";",2)_" Patient #"_RMPODFN_" ! >>>",*7
- D UPDLTR^RMPOLZA(RMPODFN,"@") ; Clear "letter to be sent" field in RMPR(665
- ;
- K ^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)
- K ^TMP($J,RMPOXITE,"LINE")
- K ^TMP($J,RMPOXITE,RMPODFN)
- I RMPOLCD="A" S $P(^RMPR(665,RMPODFN,"RMPOA"),U,9)=DT,$P(^("RMPOA"),U,10)="P"
- I RMPOLCD="B" S $P(^RMPR(665,RMPODFN,"RMPOA"),U,11)=DT,$P(^("RMPOA"),U,12)="P"
- I RMPOLCD="C" S $P(^RMPR(665,RMPODFN,"RMPOA"),U,13)=DT,$P(^("RMPOA"),U,14)="P"
- W @IOF
- Q
- ;
- LINE(X) S LNCT=LNCT+1,^TMP($J,RMPOXITE,"LINE",LNCT,0)=" "_X
- W !,?9,X
- Q
- ;
- HDRL ; Define header lines
- S HEAD(1)="Department of Veterans Affairs",POS(1)=40-($L(HEAD(1))\2)
- S HEAD(2)=RMPO("NAME"),POS(2)=40-($L(HEAD(2))\2) ;name of VAMC
- S HEAD(3)=RMPO("ADD"),POS(3)=40-($L(HEAD(3))\2) ;street address of VAMC
- S HEAD(4)=RMPO("CITY"),POS(4)=40-($L(HEAD(4))\2) ;city,state and zip of VAMC
- Q
- ;
- PHDR ; Print header
- F I=1:1:5 D LINE("")
- D LINE($E(SP,1,POS(1))_HEAD(1)),LINE($E(SP,1,POS(2))_HEAD(2))
- D LINE($E(SP,1,POS(3))_HEAD(3)),LINE($E(SP,1,POS(4))_HEAD(4))
- F I=1:1:4 D LINE("")
- Q
- ;
- DEV() ; Get device. Cannot be home device
- N DEV,POP
- ;F S DEV=0,%ZIS="Q" D ^%ZIS Q:$G(POP)=1 S DEV=1 Q:IO(0)'=IO W "Cannot Select Home Device"
- DAGAIN S DEV=0,%ZIS="MQ" K IOP D ^%ZIS Q:$G(POP)=1 DEV
- I IO(0)=IO!(IOST["SLAVE") D ^%ZISC,HOME^%ZIS W "Cannot Select Home or Slave Device" G DAGAIN
- S DEV=1 Q DEV
- EXIT ;Clean up and quit
- ; if interactive close printer
- D:'JOB ^%ZISC
- ;Kill off variables
- K %ZIS,Y,ZTSAVE,ZTDESC,ZTRTN,HEAD
- Q
- QUIT() S QUIT=$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q QUIT
- Q
- COMMON(PIKRTN) ;
- D FULL^VALM1
- S RTN="SINGLE^RMPOLZB"
- D @PIKRTN Q:$$QUIT I Y="" S VALMBCK="R" Q
- S LFNS=Y
- I 'JOB Q:'$$DEV
- Q
- ;
- PIKSOM ; ALLOW SELECTION FROM DISPLAYED ENTRIES
- K DIR S DIR(0)="LO^"_VALMBG_":"_VALMLST D ^DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLZB 6039 printed Jan 18, 2025@03:32:19 Page 2
- RMPOLZB ;EDS/PAK - HOME OXYGEN LETTERS ;7/24/98
- +1 ;;3.0;PROSTHETICS;**29,55,159**;Feb 09, 1996;Build 2
- +2 ;
- +3 ; ODJ - patch 55 - 1/29/01 - remove hard code 121 mail code and
- +4 ; replace with extrinsic (AUG-1097-32118)
- +5 ;
- +6 ; Input:
- +7 ;
- +8 ; JOB - 0: interactive, 1: job
- +9 ; RMPOLCD - Letter type code
- +10 ;
- +11 ; Output: None
- +12 ;
- +13 ; Called by:
- +14 ; EN03^RMPOLT,EN02^RMPOLY
- +15 NEW REC,POS
- +16 ; if interactive select device
- +17 IF 'JOB
- DO FULL^VALM1
- if '$$DEV
- QUIT
- +18 ; if print queued
- +19 IF $DATA(IO("Q"))
- Begin DoDot:1
- +20 KILL ZTSAVE
- +21 SET ZTDESC="RMPO : Patient Letter Print"
- SET ZTRTN="START^RMPOLZB"
- +22 SET (ZTSAVE("RMPOXITE"),ZTSAVE("JOB"),ZTSAVE("RMPOLCD"),ZTSAVE("RMPOSITE"),ZTSAVE("RMPO("),ZTSAVE("^TMP($J,RMPOXITE,"))=""
- End DoDot:1
- if '$$QUEUE^RMPOLET1(ZTDESC,ZTRTN,.ZTSAVE)
- QUIT
- DO HOME^%ZIS
- DO EXIT
- QUIT
- +23 WRITE !,"Printing...."
- +24 ;
- START ; Print H.O. correspondence for selected letter type
- +1 NEW DATE
- USE IO
- +2 SET Y=DT
- XECUTE ^DD("DD")
- SET DATE=Y
- +3 ; initialise header lines
- DO HDRL
- +4 SET RMPONAM=""
- FOR
- SET RMPONAM=$ORDER(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM))
- if RMPONAM=""
- QUIT
- Begin DoDot:1
- +5 SET RMPOLTR=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
- +6 SET RMPODFN=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
- +7 SET REC=^TMP($JOB,RMPOXITE,"RMPODEMO",RMPODFN)
- DO BODY
- End DoDot:1
- +8 DO EXIT
- QUIT
- +9 ;
- ONE ;print a single patient
- +1 ;I 'JOB D FULL^VALM1 Q:'$$DEV
- +2 ;D COMMON("PIKSOM") D ^%ZISC D CLEAN^VALM10,INIT^RMPOLT,RE^VALM4 K DIR,RTN
- +3 DO PIKSOM
- if $$QUIT
- QUIT
- IF Y=""
- SET VALMBCK="R"
- QUIT
- +4 SET LFNS=Y
- IF 'JOB
- DO FULL^VALM1
- if '$$DEV
- QUIT
- +5 IF $DATA(IO("Q"))
- Begin DoDot:1
- +6 KILL ZTSAVE
- +7 SET ZTDESC="RMPO : Patient Letter Print"
- SET ZTRTN="QUED^RMPOLZB"
- +8 SET (ZTSAVE("RMPOXITE"),ZTSAVE("JOB"),ZTSAVE("RMPOLCD"))=""
- +9 SET ZTSAVE("RMPOSITE")=""
- SET ZTSAVE("RMPO(")=""
- SET ZTSAVE("^TMP($J,RMPOXITE,")=""
- SET ZTSAVE("IO")=""
- SET ZTSAVE("LFNS")=""
- End DoDot:1
- DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !,"REQUEST QUEUED!"
- HANG 2
- DO HOME^%ZIS
- DO EXIT
- QUIT
- +10 WRITE !!,"Printing...."
- +11 ;
- QUED NEW DATE
- SET Y=DT
- XECUTE ^DD("DD")
- SET DATE=Y
- DO HDRL
- +1 USE IO
- FOR ZI=1:1:$LENGTH(LFNS,",")-1
- Begin DoDot:1
- +2 SET LFN=$PIECE(LFNS,",",ZI)
- if LFN'>0
- QUIT
- +3 SET RMPONAM=""
- SET CNT=0
- FOR
- SET RMPONAM=$ORDER(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM))
- if RMPONAM=""
- QUIT
- Begin DoDot:2
- +4 SET RMPOLTR=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
- +5 SET RMPODFN=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
- +6 SET CNT=CNT+1
- +7 if CNT=LFN
- SET ^TMP($JOB,RMPOXITE,"LTR",RMPONAM)=RMPODFN
- End DoDot:2
- End DoDot:1
- +8 SET RMPONAM=""
- FOR
- SET RMPONAM=$ORDER(^TMP($JOB,RMPOXITE,"LTR",RMPONAM))
- if RMPONAM=""
- QUIT
- DO SINGLE
- +9 KILL LFNS,LFN,ZI,RTN,DIR,RMLET
- +10 DO ^%ZISC
- DO CLEAN^VALM10
- DO INIT^RMPOLT
- DO RE^VALM4
- +11 SET VALMBCK="R"
- DO EXIT
- QUIT
- +12 ;
- SINGLE SET RMPOLTR=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,1)
- +1 SET RMPODFN=$PIECE(^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM),U,2)
- +2 SET REC=^TMP($JOB,RMPOXITE,"RMPODEMO",RMPODFN)
- +3 DO BODY
- QUIT
- BODY ; Set up array for filing and print letter
- +1 NEW I,LN,LNCT,SP,HDR,X,Y,NAME,SURNM,FRSTNM
- +2 SET $PIECE(SP," ",80)=" "
- SET LNCT=0
- +3 ;
- +4 ; Print text or blank lines in header
- +5 SET HDR=^TMP($JOB,RMPOXITE,"HEADER",RMPOLTR)
- +6 IF 'HDR
- FOR I=1:1:9
- DO LINE("")
- +7 IF HDR
- DO PHDR
- +8 ;
- +9 DO LINE(DATE)
- DO LINE("")
- +10 SET NAME=$PIECE(REC,U)
- SET SURNM=$PIECE(NAME,",",2)
- SET FRSTNM=$PIECE(NAME,",")
- +11 SET LN=$EXTRACT(FRSTNM_" "_SURNM_SP,1,40)_"In Reply Refer To: "_RMPO("NAME")_"/"_$$ROU^RMPRUTIL(RMPOXITE)
- +12 DO LINE(LN)
- +13 SET LN=$PIECE(REC,U,10)
- SET LN=$EXTRACT(LN_SP,1,40)
- +14 DO LINE(LN)
- +15 SET LN=$PIECE(REC,U,11)
- IF LN]""
- SET LN=$EXTRACT(LN_SP,1,40)
- DO LINE(LN)
- +16 IF $PIECE(REC,U,12)]""
- DO LINE($PIECE(REC,U,12))
- +17 ;
- +18 ; City, State, Zip
- +19 DO LINE($PIECE(REC,U,13)_", "_$PIECE(REC,U,14)_" "_$PIECE(REC,U,15))
- +20 ;I $P(REC,U,11)="",$P(REC,U,12)="" D LINE($E(SP,1,40)_$P(RMPODFN,U))
- +21 SET RMPORX=$PIECE(REC,U,6)
- if RMPORX=""
- SET RMPORX="Not on file"
- +22 DO LINE($EXTRACT(SP,1,40)_FRSTNM_" "_SURNM)
- +23 DO LINE($EXTRACT(SP,1,40)_"Current Home Oxygen Rx#: "_RMPORX)
- +24 SET LN=$EXTRACT(SP,1,40)_"Rx Expiration Date: "
- +25 SET RMPORXDT=$PIECE(REC,U,4)
- +26 IF RMPORXDT=""
- SET RMPORXDT="n/a"
- +27 IF '$TEST
- SET Y=RMPORXDT
- XECUTE ^DD("DD")
- SET RMPORXDT=Y
- +28 DO LINE(LN_RMPORXDT)
- DO LINE("")
- +29 DO LINE("Dear "_$SELECT($PIECE(REC,U,9)="F":"Ms. ",1:"Mr. ")_SURNM_":")
- +30 DO LINE("")
- DO LINE("")
- +31 ;
- +32 ; print letter template
- +33 SET I=0
- FOR
- SET I=$ORDER(^RMPR(665.2,RMPOLTR,1,I))
- if 'I
- QUIT
- DO LINE(^(I,0))
- +34 ;
- +35 ; Update Correspondence Tracking
- +36 ; DO NOT remove patient from list is correspondence update unsuccessful.
- +37 SET X=$$FILE^RMPOLZU(RMPODFN,"^TMP("_$JOB_","_RMPOXITE_",""LINE"")",RMPOLTR)
- +38 ; quit if error
- IF +X
- Begin DoDot:1
- +39 WRITE !!!,"<<< Error"_+X_":"_$PIECE(X,";",2)_" Patient #"_RMPODFN_" ! >>>",*7
- End DoDot:1
- QUIT
- +40 ; Clear "letter to be sent" field in RMPR(665
- DO UPDLTR^RMPOLZA(RMPODFN,"@")
- +41 ;
- +42 KILL ^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)
- +43 KILL ^TMP($JOB,RMPOXITE,"LINE")
- +44 KILL ^TMP($JOB,RMPOXITE,RMPODFN)
- +45 IF RMPOLCD="A"
- SET $PIECE(^RMPR(665,RMPODFN,"RMPOA"),U,9)=DT
- SET $PIECE(^("RMPOA"),U,10)="P"
- +46 IF RMPOLCD="B"
- SET $PIECE(^RMPR(665,RMPODFN,"RMPOA"),U,11)=DT
- SET $PIECE(^("RMPOA"),U,12)="P"
- +47 IF RMPOLCD="C"
- SET $PIECE(^RMPR(665,RMPODFN,"RMPOA"),U,13)=DT
- SET $PIECE(^("RMPOA"),U,14)="P"
- +48 WRITE @IOF
- +49 QUIT
- +50 ;
- LINE(X) SET LNCT=LNCT+1
- SET ^TMP($JOB,RMPOXITE,"LINE",LNCT,0)=" "_X
- +1 WRITE !,?9,X
- +2 QUIT
- +3 ;
- HDRL ; Define header lines
- +1 SET HEAD(1)="Department of Veterans Affairs"
- SET POS(1)=40-($LENGTH(HEAD(1))\2)
- +2 ;name of VAMC
- SET HEAD(2)=RMPO("NAME")
- SET POS(2)=40-($LENGTH(HEAD(2))\2)
- +3 ;street address of VAMC
- SET HEAD(3)=RMPO("ADD")
- SET POS(3)=40-($LENGTH(HEAD(3))\2)
- +4 ;city,state and zip of VAMC
- SET HEAD(4)=RMPO("CITY")
- SET POS(4)=40-($LENGTH(HEAD(4))\2)
- +5 QUIT
- +6 ;
- PHDR ; Print header
- +1 FOR I=1:1:5
- DO LINE("")
- +2 DO LINE($EXTRACT(SP,1,POS(1))_HEAD(1))
- DO LINE($EXTRACT(SP,1,POS(2))_HEAD(2))
- +3 DO LINE($EXTRACT(SP,1,POS(3))_HEAD(3))
- DO LINE($EXTRACT(SP,1,POS(4))_HEAD(4))
- +4 FOR I=1:1:4
- DO LINE("")
- +5 QUIT
- +6 ;
- DEV() ; Get device. Cannot be home device
- +1 NEW DEV,POP
- +2 ;F S DEV=0,%ZIS="Q" D ^%ZIS Q:$G(POP)=1 S DEV=1 Q:IO(0)'=IO W "Cannot Select Home Device"
- DAGAIN SET DEV=0
- SET %ZIS="MQ"
- KILL IOP
- DO ^%ZIS
- if $GET(POP)=1
- QUIT DEV
- +1 IF IO(0)=IO!(IOST["SLAVE")
- DO ^%ZISC
- DO HOME^%ZIS
- WRITE "Cannot Select Home or Slave Device"
- GOTO DAGAIN
- +2 SET DEV=1
- QUIT DEV
- EXIT ;Clean up and quit
- +1 ; if interactive close printer
- +2 if 'JOB
- DO ^%ZISC
- +3 ;Kill off variables
- +4 KILL %ZIS,Y,ZTSAVE,ZTDESC,ZTRTN,HEAD
- +5 QUIT
- QUIT() SET QUIT=$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT QUIT
- +1 QUIT
- COMMON(PIKRTN) ;
- +1 DO FULL^VALM1
- +2 SET RTN="SINGLE^RMPOLZB"
- +3 DO @PIKRTN
- if $$QUIT
- QUIT
- IF Y=""
- SET VALMBCK="R"
- QUIT
- +4 SET LFNS=Y
- +5 IF 'JOB
- if '$$DEV
- QUIT
- +6 QUIT
- +7 ;
- PIKSOM ; ALLOW SELECTION FROM DISPLAYED ENTRIES
- +1 KILL DIR
- SET DIR(0)="LO^"_VALMBG_":"_VALMLST
- DO ^DIR
- +2 QUIT