- PSXRACT ;BIR/HW-ACTIVITY REPORT [ 05/10/97 2:28 PM ] ; 31 Oct 2000 2:28 PM
- ;;2.0;CMOP;**1,31**;11 Apr 97
- ; External reference to ^PSRX( supported by DBIA #1221
- ; External reference to ^PS(59 supported by DBIA #1976
- ;
- BEGDATE S DIR(0)="DO",DIR("A")="ENTER BEGINNING TRANSMISSION DATE " D ^DIR K DIR
- G:$D(DIRUT)!(X']"") END
- S PSXB=Y K Y,X
- I PSXB>DT W !!,"Future dates are not allowed.",! G BEGDATE
- ENDDATE S Y=DT X ^DD("DD") S ZZTODAY=Y K Y
- K X,Y
- S DIR(0)="DO",DIR("A")="ENTER ENDING TRANSMISSION DATE ",DIR("B")=ZZTODAY
- D ^DIR K DIR
- G:$D(DIRUT) END
- S PSXE=Y K Y
- I PSXE<PSXB W !,"Ending date must follow beginning date!" G ENDDATE
- K ZZTODAY
- D SEL Q:'$D(DIVNM)
- DEVICE W !! S %ZIS="MQ",%ZIS("A")="Select Printer: ",%ZIS("B")=""
- D ^%ZIS G:POP END S PSXLAP=ION
- I $E(IOST,1,2)["C-" G START
- I '$D(IO("Q")) G ST0
- D ^%ZISC K J,C
- QUE S ZTSAVE("PSXB")="",ZTSAVE("PSXE")="",ZTSAVE("DIVNM(")="",ZTSAVE("DIVDA(")="",ZTIO=PSXLAP
- S ZTRTN="START^PSXRACT"
- S ZTDESC="CMOP Activity Report"
- D ^%ZTLOAD
- Q1 W:$D(ZTSK) !!,"Report Queued to Print!!"
- K DIR,PSXB,PSXE,Y
- Q
- ST0 U IO
- ;Called by taskman to print the CMOP Activity Report
- START S:$D(ZTQUEUED) ZTREQ="@"
- S LINE="W ! F I=1:1:80 W ""="""
- DIVISION ;
- S DIVDA=0 F S DIVDA=$O(DIVDA(DIVDA)) Q:DIVDA'>0 D ONEDIV
- D GRNDSUM
- G EXIT
- ;
- Q
- ONEDIV ;
- S LINE="W ! F I=1:1:80 W ""=""",CT=0
- S Y=PSXB X ^DD("DD") S PSXBE=Y
- S Y=PSXE X ^DD("DD") S PSXEE=Y
- S PSXE1=PSXE+.99999,PSXD=PSXB-.00001
- D TITLE
- BATCH F S PSXD=$O(^PSX(550.2,"D",PSXD)) Q:(+PSXD'>0)!(+PSXD>PSXE1) D Q:$G(PSXFLAG)=1
- .F P5502=0:0 S P5502=$O(^PSX(550.2,"D",PSXD,P5502)) Q:'P5502 D Q:$G(PSXFLAG)=1
- ..S BATCH=+$P($G(^PSX(550.2,P5502,0)),"^") Q:$G(BATCH)']""
- ..S DIV=$P($G(^PSX(550.2,P5502,0)),"^",3),DIV=$P($G(^PS(59,DIV,0)),"^")
- ..I '$D(DIVNM(DIV)) Q
- ..I DIV'=DIVDA(DIVDA) Q
- ..S NODE=$G(^PSX(550.2,P5502,1)) Q:$G(NODE)']""
- ..S ORDS=$P($G(NODE),"^",7),TORDS=$G(TORDS)+ORDS,RTRN=$P(NODE,"^",2)
- ..S TORDS(DIV)=$G(TORDS(DIV))+ORDS
- ..S RXS=$P($G(NODE),"^",8),TRXS=$G(TRXS)+RXS
- ..S TRXS(DIV)=$G(TRXS(DIV))+RXS
- ..F PSXR=0:0 S PSXR=$O(^PSRX("AS",PSXD,PSXR)) Q:'PSXR D
- ...S PSXF="" F S PSXF=$O(^PSRX("AS",PSXD,PSXR,PSXF)) Q:($G(PSXF)']"") D RX
- ..D PRINT Q:$G(PSXFLAG)=1
- X LINE
- S DIV=DIVDA(DIVDA)
- W !,?9,DIV,?35,$J($G(TORDS(DIV)),7),?43,$J($G(TRXS(DIV)),6),?53,$J($G(PSXCRT(DIV)),7),?63,$J($G(PSXNDT(DIV)),7),?73,$J($G(PSXCUT(DIV)),5)
- Q
- GRNDSUM ;
- S DIVDA(0)=" Grand Total Summary",DIVDA=0
- D TITLE
- S DIV=0 F S DIV=$O(TORDS(DIV)) Q:DIV="" D
- .W !,?9,DIV,?35,$J($G(TORDS(DIV)),7),?43,$J($G(TRXS(DIV)),6),?53,$J($G(PSXCRT(DIV)),7),?63,$J($G(PSXNDT(DIV)),7),?73,$J($G(PSXCUT(DIV)),5)
- X LINE
- W !!,"TOTAL",?35,$J($G(TORDS),7),?43,$J($G(TRXS),6),?53,$J($G(PSXCRT),7),?63,$J($G(PSXNDT),7),?73,$J($G(PSXCUT),5)
- END K DIR,DIRUT,PSXB,PSXE,ZZTODAY,PSXLAP,PSXE1,PSXOT,PSXD,P5502,BATCH
- K DIV,NODE,TORDS,TRXS,PSXR,PSXF,GT,PSXFLAG,ZNODE,ZFILL,PSXSTAT,PSXCR
- K PSX,PSXCRT,PSXCUT,PSXLINE,PSXNDT,PSXNOW,X,Y,%,RTRN
- Q
- EXIT ;
- D END
- K DIVDA,DIVNM,PSXB,PSXE,LINE,CT,I,PSXBE,PSXEE,ZZTOT,ZTSK
- D ^%ZISC
- Q
- RX ; COUNT RX DATA
- I $D(^PSRX(PSXR,4,0)) F PSX=0:0 S PSX=$O(^PSRX(PSXR,4,PSX)) Q:'PSX D
- .S ZNODE=$G(^PSRX(PSXR,4,PSX,0)),ZFILL=$P($G(ZNODE),"^",3)
- .I $G(ZFILL)'=PSXF K ZFILL Q
- .I +$G(ZNODE)'=BATCH Q
- .S PSXSTAT=$P($G(ZNODE),"^",4),PSX(ZFILL)=PSXSTAT
- .K ZNODE,ZFILL,PSXSTAT
- I $G(PSX(PSXF))=1 S PSXCR=$G(PSXCR)+1,PSXCRT=$G(PSXCRT)+1 D Q
- .S PSXCRT(DIV)=$G(PSXCRT(DIV))+1
- I $G(PSX(PSXF))=3 S PSXND=$G(PSXND)+1,PSXNDT=$G(PSXNDT)+1 D Q
- .S PSXNDT(DIV)=$G(PSXNDT(DIV))+1
- I $G(PSX(PSXF))=2 S PSXRT=$G(PSXRT)+1 S:(RTRN)>0 COM="FILLED IN "_$G(RTRN)
- S PSXCU=$G(PSXCU)+1,PSXCUT=$G(PSXCUT)+1
- S PSXCUT(DIV)=$G(PSXCUT(DIV))+1
- S:$G(COM)'="" PSXCU=""
- Q
- TITLE I IOST["C-" W @IOF
- S Y=PSXB X ^DD("DD") S PSXBP=Y
- S Y=PSXE X ^DD("DD") S PSXEP=Y
- D NOW^%DTC S Y=% X ^DD("DD") S PSXNOW=Y
- W !,?30,"CMOP ACTIVITY REPORT"_$S($G(ZZTOT)=1:" SUMMARY",1:"")
- W !,DIVDA(DIVDA)
- W !,"For ",PSXBP," thru ",$P(PSXEP,"@"),?40,"Printed: ",PSXNOW
- S PSXLINE=6
- K PSXBP,PSXEP
- X LINE
- AHEAD W !,"TRANS #",?9,"DIVISION",?37,"ORDERS",?45,"RXS",?53,"RELEASED",?63,"NOT DISP",?73,"UNREL"
- X LINE
- Q
- PRINT I IOST["C-",($G(PSXLINE)>20) D Q:$G(PSXFLAG)=1
- .S DIR(0)="E" D ^DIR K DIR I $G(Y)'=1 S PSXFLAG=1 K Y Q
- .D TITLE
- I IOST'["C-",($G(PSXLINE)>60) W @IOF D TITLE
- ;S:$G(COM)="" PSXCU=""
- W !,$J($G(BATCH),6),?9,$S($G(COM)'="":$E($G(DIV),1,10)_" "_$G(COM),1:$G(DIV)),?35,$J($G(ORDS),7),?43,$J($G(RXS),6),?53,$J($G(PSXCR),7),?63,$J($G(PSXND),7),?73,$J($G(PSXCU),5)
- S PSXLINE=$G(PSXLINE)+1
- K BATCH,DIV,ORDS,RXS,PSXCR,PSXND,PSXCU,PSXRT,COM,COM1
- Q
- SEL ;Select divisions
- ; returns arrays
- ; DIVNM("names of divisions")=selection number
- ; DIVDA("iens of divisions")=name of division
- ; for testing
- W !!,"SELECTION OF DIVISION(S)",!
- S DIV="" K DIVNM,DIVDA,DIVX
- F I=1:1 S DIV=$O(^PS(59,"B",DIV)) Q:DIV="" S DIVNM(I)=DIV,DIVNM(DIV)=I,DIVDA=$O(^PS(59,"B",DIV,0)),DIVNM(I,"I")=DIVDA
- S I=I-1
- K DIR S DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
- D ^DIR K DIR G:Y="A" ALL
- G:Y="S" SELECT
- Q
- SELECT ;
- F C=1:1:I S DIR("A",C)=C_" "_DIVNM(C)
- S DIR(0)="LO^1:"_I,DIR("A")="Select Division(s) "
- D ^DIR
- I '+Y K DIVNM Q
- M DIVX=DIVNM K DIVNM
- F I=1:1 S X=$P(Y,",",I) Q:'X M DIVNM(X)=DIVX(X) S DIVNM=DIVX(X),DIVNM(DIVNM)=X
- K DIVX,DIR
- ALL W !!,"You have selected:",! S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV W !,DIV,?5,DIVNM(DIV)
- S DIR(0)="Y",DIR("A")="Is this corrrect ? ",DIR("B")="YES" D ^DIR
- K DIR
- I Y D Q
- .K DIVDA
- .S DIV=0 F S DIV=$O(DIVNM(DIV)) Q:'DIV S DA=DIVNM(DIV,"I"),DIVDA(DA)=DIVNM(DIV) K DIVNM(DIV)
- G SEL
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXRACT 5711 printed Jan 18, 2025@02:46 Page 2
- PSXRACT ;BIR/HW-ACTIVITY REPORT [ 05/10/97 2:28 PM ] ; 31 Oct 2000 2:28 PM
- +1 ;;2.0;CMOP;**1,31**;11 Apr 97
- +2 ; External reference to ^PSRX( supported by DBIA #1221
- +3 ; External reference to ^PS(59 supported by DBIA #1976
- +4 ;
- BEGDATE SET DIR(0)="DO"
- SET DIR("A")="ENTER BEGINNING TRANSMISSION DATE "
- DO ^DIR
- KILL DIR
- +1 if $DATA(DIRUT)!(X']"")
- GOTO END
- +2 SET PSXB=Y
- KILL Y,X
- +3 IF PSXB>DT
- WRITE !!,"Future dates are not allowed.",!
- GOTO BEGDATE
- ENDDATE SET Y=DT
- XECUTE ^DD("DD")
- SET ZZTODAY=Y
- KILL Y
- +1 KILL X,Y
- +2 SET DIR(0)="DO"
- SET DIR("A")="ENTER ENDING TRANSMISSION DATE "
- SET DIR("B")=ZZTODAY
- +3 DO ^DIR
- KILL DIR
- +4 if $DATA(DIRUT)
- GOTO END
- +5 SET PSXE=Y
- KILL Y
- +6 IF PSXE<PSXB
- WRITE !,"Ending date must follow beginning date!"
- GOTO ENDDATE
- +7 KILL ZZTODAY
- +8 DO SEL
- if '$DATA(DIVNM)
- QUIT
- DEVICE WRITE !!
- SET %ZIS="MQ"
- SET %ZIS("A")="Select Printer: "
- SET %ZIS("B")=""
- +1 DO ^%ZIS
- if POP
- GOTO END
- SET PSXLAP=ION
- +2 IF $EXTRACT(IOST,1,2)["C-"
- GOTO START
- +3 IF '$DATA(IO("Q"))
- GOTO ST0
- +4 DO ^%ZISC
- KILL J,C
- QUE SET ZTSAVE("PSXB")=""
- SET ZTSAVE("PSXE")=""
- SET ZTSAVE("DIVNM(")=""
- SET ZTSAVE("DIVDA(")=""
- SET ZTIO=PSXLAP
- +1 SET ZTRTN="START^PSXRACT"
- +2 SET ZTDESC="CMOP Activity Report"
- +3 DO ^%ZTLOAD
- Q1 if $DATA(ZTSK)
- WRITE !!,"Report Queued to Print!!"
- +1 KILL DIR,PSXB,PSXE,Y
- +2 QUIT
- ST0 USE IO
- +1 ;Called by taskman to print the CMOP Activity Report
- START if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 SET LINE="W ! F I=1:1:80 W ""="""
- DIVISION ;
- +1 SET DIVDA=0
- FOR
- SET DIVDA=$ORDER(DIVDA(DIVDA))
- if DIVDA'>0
- QUIT
- DO ONEDIV
- +2 DO GRNDSUM
- +3 GOTO EXIT
- +4 ;
- +5 QUIT
- ONEDIV ;
- +1 SET LINE="W ! F I=1:1:80 W ""="""
- SET CT=0
- +2 SET Y=PSXB
- XECUTE ^DD("DD")
- SET PSXBE=Y
- +3 SET Y=PSXE
- XECUTE ^DD("DD")
- SET PSXEE=Y
- +4 SET PSXE1=PSXE+.99999
- SET PSXD=PSXB-.00001
- +5 DO TITLE
- BATCH FOR
- SET PSXD=$ORDER(^PSX(550.2,"D",PSXD))
- if (+PSXD'>0)!(+PSXD>PSXE1)
- QUIT
- Begin DoDot:1
- +1 FOR P5502=0:0
- SET P5502=$ORDER(^PSX(550.2,"D",PSXD,P5502))
- if 'P5502
- QUIT
- Begin DoDot:2
- +2 SET BATCH=+$PIECE($GET(^PSX(550.2,P5502,0)),"^")
- if $GET(BATCH)']""
- QUIT
- +3 SET DIV=$PIECE($GET(^PSX(550.2,P5502,0)),"^",3)
- SET DIV=$PIECE($GET(^PS(59,DIV,0)),"^")
- +4 IF '$DATA(DIVNM(DIV))
- QUIT
- +5 IF DIV'=DIVDA(DIVDA)
- QUIT
- +6 SET NODE=$GET(^PSX(550.2,P5502,1))
- if $GET(NODE)']""
- QUIT
- +7 SET ORDS=$PIECE($GET(NODE),"^",7)
- SET TORDS=$GET(TORDS)+ORDS
- SET RTRN=$PIECE(NODE,"^",2)
- +8 SET TORDS(DIV)=$GET(TORDS(DIV))+ORDS
- +9 SET RXS=$PIECE($GET(NODE),"^",8)
- SET TRXS=$GET(TRXS)+RXS
- +10 SET TRXS(DIV)=$GET(TRXS(DIV))+RXS
- +11 FOR PSXR=0:0
- SET PSXR=$ORDER(^PSRX("AS",PSXD,PSXR))
- if 'PSXR
- QUIT
- Begin DoDot:3
- +12 SET PSXF=""
- FOR
- SET PSXF=$ORDER(^PSRX("AS",PSXD,PSXR,PSXF))
- if ($GET(PSXF)']"")
- QUIT
- DO RX
- End DoDot:3
- +13 DO PRINT
- if $GET(PSXFLAG)=1
- QUIT
- End DoDot:2
- if $GET(PSXFLAG)=1
- QUIT
- End DoDot:1
- if $GET(PSXFLAG)=1
- QUIT
- +14 XECUTE LINE
- +15 SET DIV=DIVDA(DIVDA)
- +16 WRITE !,?9,DIV,?35,$JUSTIFY($GET(TORDS(DIV)),7),?43,$JUSTIFY($GET(TRXS(DIV)),6),?53,$JUSTIFY($GET(PSXCRT(DIV)),7),?63,$JUSTIFY($GET(PSXNDT(DIV)),7),?73,$JUSTIFY($GET(PSXCUT(DIV)),5)
- +17 QUIT
- GRNDSUM ;
- +1 SET DIVDA(0)=" Grand Total Summary"
- SET DIVDA=0
- +2 DO TITLE
- +3 SET DIV=0
- FOR
- SET DIV=$ORDER(TORDS(DIV))
- if DIV=""
- QUIT
- Begin DoDot:1
- +4 WRITE !,?9,DIV,?35,$JUSTIFY($GET(TORDS(DIV)),7),?43,$JUSTIFY($GET(TRXS(DIV)),6),?53,$JUSTIFY($GET(PSXCRT(DIV)),7),?63,$JUSTIFY($GET(PSXNDT(DIV)),7),?73,$JUSTIFY($GET(PSXCUT(DIV)),5)
- End DoDot:1
- +5 XECUTE LINE
- +6 WRITE !!,"TOTAL",?35,$JUSTIFY($GET(TORDS),7),?43,$JUSTIFY($GET(TRXS),6),?53,$JUSTIFY($GET(PSXCRT),7),?63,$JUSTIFY($GET(PSXNDT),7),?73,$JUSTIFY($GET(PSXCUT),5)
- END KILL DIR,DIRUT,PSXB,PSXE,ZZTODAY,PSXLAP,PSXE1,PSXOT,PSXD,P5502,BATCH
- +1 KILL DIV,NODE,TORDS,TRXS,PSXR,PSXF,GT,PSXFLAG,ZNODE,ZFILL,PSXSTAT,PSXCR
- +2 KILL PSX,PSXCRT,PSXCUT,PSXLINE,PSXNDT,PSXNOW,X,Y,%,RTRN
- +3 QUIT
- EXIT ;
- +1 DO END
- +2 KILL DIVDA,DIVNM,PSXB,PSXE,LINE,CT,I,PSXBE,PSXEE,ZZTOT,ZTSK
- +3 DO ^%ZISC
- +4 QUIT
- RX ; COUNT RX DATA
- +1 IF $DATA(^PSRX(PSXR,4,0))
- FOR PSX=0:0
- SET PSX=$ORDER(^PSRX(PSXR,4,PSX))
- if 'PSX
- QUIT
- Begin DoDot:1
- +2 SET ZNODE=$GET(^PSRX(PSXR,4,PSX,0))
- SET ZFILL=$PIECE($GET(ZNODE),"^",3)
- +3 IF $GET(ZFILL)'=PSXF
- KILL ZFILL
- QUIT
- +4 IF +$GET(ZNODE)'=BATCH
- QUIT
- +5 SET PSXSTAT=$PIECE($GET(ZNODE),"^",4)
- SET PSX(ZFILL)=PSXSTAT
- +6 KILL ZNODE,ZFILL,PSXSTAT
- End DoDot:1
- +7 IF $GET(PSX(PSXF))=1
- SET PSXCR=$GET(PSXCR)+1
- SET PSXCRT=$GET(PSXCRT)+1
- Begin DoDot:1
- +8 SET PSXCRT(DIV)=$GET(PSXCRT(DIV))+1
- End DoDot:1
- QUIT
- +9 IF $GET(PSX(PSXF))=3
- SET PSXND=$GET(PSXND)+1
- SET PSXNDT=$GET(PSXNDT)+1
- Begin DoDot:1
- +10 SET PSXNDT(DIV)=$GET(PSXNDT(DIV))+1
- End DoDot:1
- QUIT
- +11 IF $GET(PSX(PSXF))=2
- SET PSXRT=$GET(PSXRT)+1
- if (RTRN)>0
- SET COM="FILLED IN "_$GET(RTRN)
- +12 SET PSXCU=$GET(PSXCU)+1
- SET PSXCUT=$GET(PSXCUT)+1
- +13 SET PSXCUT(DIV)=$GET(PSXCUT(DIV))+1
- +14 if $GET(COM)'=""
- SET PSXCU=""
- +15 QUIT
- TITLE IF IOST["C-"
- WRITE @IOF
- +1 SET Y=PSXB
- XECUTE ^DD("DD")
- SET PSXBP=Y
- +2 SET Y=PSXE
- XECUTE ^DD("DD")
- SET PSXEP=Y
- +3 DO NOW^%DTC
- SET Y=%
- XECUTE ^DD("DD")
- SET PSXNOW=Y
- +4 WRITE !,?30,"CMOP ACTIVITY REPORT"_$SELECT($GET(ZZTOT)=1:" SUMMARY",1:"")
- +5 WRITE !,DIVDA(DIVDA)
- +6 WRITE !,"For ",PSXBP," thru ",$PIECE(PSXEP,"@"),?40,"Printed: ",PSXNOW
- +7 SET PSXLINE=6
- +8 KILL PSXBP,PSXEP
- +9 XECUTE LINE
- AHEAD WRITE !,"TRANS #",?9,"DIVISION",?37,"ORDERS",?45,"RXS",?53,"RELEASED",?63,"NOT DISP",?73,"UNREL"
- +1 XECUTE LINE
- +2 QUIT
- PRINT IF IOST["C-"
- IF ($GET(PSXLINE)>20)
- Begin DoDot:1
- +1 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $GET(Y)'=1
- SET PSXFLAG=1
- KILL Y
- QUIT
- +2 DO TITLE
- End DoDot:1
- if $GET(PSXFLAG)=1
- QUIT
- +3 IF IOST'["C-"
- IF ($GET(PSXLINE)>60)
- WRITE @IOF
- DO TITLE
- +4 ;S:$G(COM)="" PSXCU=""
- +5 WRITE !,$JUSTIFY($GET(BATCH),6),?9,$SELECT($GET(COM)'="":$EXTRACT($GET(DIV),1,10)_" "_$GET(COM),1:$GET(DIV)),?35,$JUSTIFY($GET(ORDS),7),?43,$JUSTIFY($GET(RXS),6),?53,$JUSTIFY($GET(PSXCR),7),?63,$JUSTIFY($GET(PSXND),7),?73,$JUSTIFY($GET(PSXCU),5
- )
- +6 SET PSXLINE=$GET(PSXLINE)+1
- +7 KILL BATCH,DIV,ORDS,RXS,PSXCR,PSXND,PSXCU,PSXRT,COM,COM1
- +8 QUIT
- SEL ;Select divisions
- +1 ; returns arrays
- +2 ; DIVNM("names of divisions")=selection number
- +3 ; DIVDA("iens of divisions")=name of division
- +4 ; for testing
- +5 WRITE !!,"SELECTION OF DIVISION(S)",!
- +6 SET DIV=""
- KILL DIVNM,DIVDA,DIVX
- +7 FOR I=1:1
- SET DIV=$ORDER(^PS(59,"B",DIV))
- if DIV=""
- QUIT
- SET DIVNM(I)=DIV
- SET DIVNM(DIV)=I
- SET DIVDA=$ORDER(^PS(59,"B",DIV,0))
- SET DIVNM(I,"I")=DIVDA
- +8 SET I=I-1
- +9 KILL DIR
- SET DIR(0)="S^A:ALL DIVISIONS;S:SELECT DIVISIONS"
- +10 DO ^DIR
- KILL DIR
- if Y="A"
- GOTO ALL
- +11 if Y="S"
- GOTO SELECT
- +12 QUIT
- SELECT ;
- +1 FOR C=1:1:I
- SET DIR("A",C)=C_" "_DIVNM(C)
- +2 SET DIR(0)="LO^1:"_I
- SET DIR("A")="Select Division(s) "
- +3 DO ^DIR
- +4 IF '+Y
- KILL DIVNM
- QUIT
- +5 MERGE DIVX=DIVNM
- KILL DIVNM
- +6 FOR I=1:1
- SET X=$PIECE(Y,",",I)
- if 'X
- QUIT
- MERGE DIVNM(X)=DIVX(X)
- SET DIVNM=DIVX(X)
- SET DIVNM(DIVNM)=X
- +7 KILL DIVX,DIR
- ALL WRITE !!,"You have selected:",!
- SET DIV=0
- FOR
- SET DIV=$ORDER(DIVNM(DIV))
- if 'DIV
- QUIT
- WRITE !,DIV,?5,DIVNM(DIV)
- +1 SET DIR(0)="Y"
- SET DIR("A")="Is this corrrect ? "
- SET DIR("B")="YES"
- DO ^DIR
- +2 KILL DIR
- +3 IF Y
- Begin DoDot:1
- +4 KILL DIVDA
- +5 SET DIV=0
- FOR
- SET DIV=$ORDER(DIVNM(DIV))
- if 'DIV
- QUIT
- SET DA=DIVNM(DIV,"I")
- SET DIVDA(DA)=DIVNM(DIV)
- KILL DIVNM(DIV)
- End DoDot:1
- QUIT
- +6 GOTO SEL
- +7 ;