- ORVOM0 ; slc/dcm - Gathers parts to send ;1/23/91 06:47 ;
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- S DIT=0,DL=DRN,DRN=1001,DHS=DH,DSEC=0
- S ;
- K ^UTILITY("DI",$J)
- I ;
- M S DIRS="K ^UTILITY(U,$J),^UTILITY(""DIK"",$J) "
- W !,"MAXIMUM ROUTINE SIZE(BYTES): ",^DD("ROU"),"// "
- R %:$S($D(DTIME):DTIME,1:60) E S DTOUT=1 G Q
- S DIFRM=^DD("ROU")
- I %]"" G Q:%[U S DIFRM=% I %\1'=%!(%<2000)!(%>9999) D M^ORVOMH G M
- GO W !,"...OK, this may take a while, hold on please..."
- S Y=101,Y(101)="",X="PRO" D ADD
- K %,%1,%2,%3,Y,CTR,TOP G ^ORVOM1
- ;
- ADD ;
- Q:$D(^DIC(Y,0))[0!$D(DTL(Y)) Q:$P(^(0),X,1)]""!'$D(^(0,"GL")) S Y=^("GL")
- I $L(DH) D:$O(@(Y_"""B"",DH,0)")) A F S DH=$O(@(Y_"""B"",DH)")) Q:DH=""!($E(DH,1,$L(DHS))'=DHS)!($E(DH,($L(DHS)+1))="Z") D A
- S II=0 F S II=$O(^ORD(100.99,1,5,DPK,1,II)) Q:II<1 S D=+^(II,0) D:'$D(^UTILITY(U,$J,X,D)) A1 S III=0 F S III=$O(^ORD(100.99,1,5,DPK,1,II,1,III)) Q:III<1 S MEN=^(III,0) D MEN
- S DH=DHS
- Q
- A ;
- S D=$O(@(Y_"""B"",DH,0)"))
- A1 S %X=Y_"D,",%Y="^UTILITY(U,$J,X,D,"
- S Q(X)=0 D %XY^%RCR
- S %=^UTILITY(U,$J,X,D,0),%1=+$P(%,U,12),%1=$S($D(^DIC(9.4,%1,0)):$P(^(0),U),1:""),$P(%,U,12)=%1,$P(%,U,5)=""
- S ^UTILITY(U,$J,X,D,0)=% I $D(^(10,0)) S CTR=$P(^(0),"^",4),TOP=$P(^(0),"^",3) K ^("B"),^("C")
- I $D(^UTILITY(U,$J,X,D,5)) S %=$P(^(5),"^"),%1=$P(%,";",2) I %,$D(@("^"_%1_+%_",0)")) S %=$P(^(0),"^"),$P(^UTILITY(U,$J,X,D,5),"^")=%_";"_%1
- S %=0 F S %=$O(^ORD(101,D,10,%)) Q:'% I $D(^(%,0)) S %2=^(0) I $D(^ORD(101,+%2,0)) S %3=$P(^(0),"^"),%1=$E(%3,1,$L(DHS)) D A2
- I $D(^UTILITY(U,$J,X,D,10,0)) S $P(^(0),"^",3,4)=CTR_"^"_TOP
- I $D(^UTILITY(U,$J,X,D,3,0)) K ^("B") S I=0 F S I=$O(^UTILITY(U,$J,X,D,3,I)) Q:I<1 S KEY=^(I,0) K ^(0) I $D(^DIC(19.1,+KEY,0)) S KEY=$P(^(0),"^"),^UTILITY(U,$J,X,D,3,I,0)=KEY
- Q
- ;
- Q ;
- K ^UTILITY($J),^(U,$J),DH,DHS,EH,ORVROM,DR,DD,DLAYGO,DIRS,DIMA,DMAX,DWLW,DREF,D1
- K DIX,DIY,DO,DZ,DIK,DIFQ,DDF,DDT,NO,DIF,DIG,DIH,DIU,DIV,DIW
- K %A,%B,%C,%V,%X,%Y,%Z,NM,DG,D0,DA,DIFRM,DL,D,E,F,R,III,KEY,TXT,DIC,DIE,DN,DPK,DQ,DRN
- K DIFQR,DNAME,DSEC,DTL,DIFC,Q,DIDIU,DIFKEP,DIT,DILN2 Q
- ;
- MEN ;add to menu
- Q:'$D(^ORD(101,+MEN,0)) S OMEN=$P(^(0),"^"),IT=$O(^ORD(101,+MEN,10,"B",D,0)) Q:$D(^UTILITY(U,$J,X,D,"MEN",OMEN)) S ^UTILITY(U,$J,X,D,"MEN",OMEN)=$S(IT:^ORD(101,+MEN,10,IT,0),1:D)
- I IT,$P(^ORD(101,+MEN,10,IT,0),"^",4) S X0=$P(^(0),"^",4),$P(^(0),"^",4)="" I $D(^ORD(101,X0,0)) S $P(^UTILITY(U,$J,X,D,"MEN",OMEN),"^",4)=$P(^(0),"^")
- W !,"Sending "_$P(^ORD(101,D,0),"^")_" to go on "_$P(^ORD(101,+MEN,0),"^")_" menu."
- Q
- A2 I %1'=DHS,%3'?1"ORB".E K ^UTILITY(U,$J,X,D,10,%) S CTR=CTR-1,TOP=% Q
- S ^UTILITY(U,$J,X,D,10,%,U)=%3
- I $P(%2,"^",4),$D(^ORD(101,$P(%2,"^",4),0)) S $P(^UTILITY(U,$J,X,D,10,%,0),"^",4)=$P(^(0),"^")
- Q
- ORVOM0 ; slc/dcm - Gathers parts to send ;1/23/91 06:47 ;
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- +2 SET DIT=0
- SET DL=DRN
- SET DRN=1001
- SET DHS=DH
- SET DSEC=0
- S ;
- +1 KILL ^UTILITY("DI",$JOB)
- I ;
- M SET DIRS="K ^UTILITY(U,$J),^UTILITY(""DIK"",$J) "
- +1 WRITE !,"MAXIMUM ROUTINE SIZE(BYTES): ",^DD("ROU"),"// "
- +2 READ %:$SELECT($DATA(DTIME):DTIME,1:60)
- IF '$TEST
- SET DTOUT=1
- GOTO Q
- +3 SET DIFRM=^DD("ROU")
- +4 IF %]""
- IF %[U
- GOTO Q
- SET DIFRM=%
- IF %\1'=%!(%<2000)!(%>9999)
- DO M^ORVOMH
- GOTO M
- GO WRITE !,"...OK, this may take a while, hold on please..."
- +1 SET Y=101
- SET Y(101)=""
- SET X="PRO"
- DO ADD
- +2 KILL %,%1,%2,%3,Y,CTR,TOP
- GOTO ^ORVOM1
- +3 ;
- ADD ;
- +1 IF $DATA(^DIC(Y,0))[0!$DATA(DTL(Y))
- QUIT
- IF $PIECE(^(0),X,1)]""!'$DATA(^(0,"GL"))
- QUIT
- SET Y=^("GL")
- +2 IF $LENGTH(DH)
- IF $ORDER(@(Y_"""B"",DH,0)"))
- DO A
- FOR
- SET DH=$ORDER(@(Y_"""B"",DH)"))
- IF DH=""!($EXTRACT(DH,1,$LENGTH(DHS))'=DHS)!($EXTRACT(DH,($LENGTH(DHS)+1))="Z")
- QUIT
- DO A
- +3 SET II=0
- FOR
- SET II=$ORDER(^ORD(100.99,1,5,DPK,1,II))
- IF II<1
- QUIT
- SET D=+^(II,0)
- IF '$DATA(^UTILITY(U,$JOB,X,D))
- DO A1
- SET III=0
- FOR
- SET III=$ORDER(^ORD(100.99,1,5,DPK,1,II,1,III))
- IF III<1
- QUIT
- SET MEN=^(III,0)
- DO MEN
- +4 SET DH=DHS
- +5 QUIT
- A ;
- +1 SET D=$ORDER(@(Y_"""B"",DH,0)"))
- A1 SET %X=Y_"D,"
- SET %Y="^UTILITY(U,$J,X,D,"
- +1 SET Q(X)=0
- DO %XY^%RCR
- +2 SET %=^UTILITY(U,$JOB,X,D,0)
- SET %1=+$PIECE(%,U,12)
- SET %1=$SELECT($DATA(^DIC(9.4,%1,0)):$PIECE(^(0),U),1:"")
- SET $PIECE(%,U,12)=%1
- SET $PIECE(%,U,5)=""
- +3 SET ^UTILITY(U,$JOB,X,D,0)=%
- IF $DATA(^(10,0))
- SET CTR=$PIECE(^(0),"^",4)
- SET TOP=$PIECE(^(0),"^",3)
- KILL ^("B"),^("C")
- +4 IF $DATA(^UTILITY(U,$JOB,X,D,5))
- SET %=$PIECE(^(5),"^")
- SET %1=$PIECE(%,";",2)
- IF %
- IF $DATA(@("^"_%1_+%_",0)"))
- SET %=$PIECE(^(0),"^")
- SET $PIECE(^UTILITY(U,$JOB,X,D,5),"^")=%_";"_%1
- +5 SET %=0
- FOR
- SET %=$ORDER(^ORD(101,D,10,%))
- IF '%
- QUIT
- IF $DATA(^(%,0))
- SET %2=^(0)
- IF $DATA(^ORD(101,+%2,0))
- SET %3=$PIECE(^(0),"^")
- SET %1=$EXTRACT(%3,1,$LENGTH(DHS))
- DO A2
- +6 IF $DATA(^UTILITY(U,$JOB,X,D,10,0))
- SET $PIECE(^(0),"^",3,4)=CTR_"^"_TOP
- +7 IF $DATA(^UTILITY(U,$JOB,X,D,3,0))
- KILL ^("B")
- SET I=0
- FOR
- SET I=$ORDER(^UTILITY(U,$JOB,X,D,3,I))
- IF I<1
- QUIT
- SET KEY=^(I,0)
- KILL ^(0)
- IF $DATA(^DIC(19.1,+KEY,0))
- SET KEY=$PIECE(^(0),"^")
- SET ^UTILITY(U,$JOB,X,D,3,I,0)=KEY
- +8 QUIT
- +9 ;
- Q ;
- +1 KILL ^UTILITY($JOB),^(U,$JOB),DH,DHS,EH,ORVROM,DR,DD,DLAYGO,DIRS,DIMA,DMAX,DWLW,DREF,D1
- +2 KILL DIX,DIY,DO,DZ,DIK,DIFQ,DDF,DDT,NO,DIF,DIG,DIH,DIU,DIV,DIW
- +3 KILL %A,%B,%C,%V,%X,%Y,%Z,NM,DG,D0,DA,DIFRM,DL,D,E,F,R,III,KEY,TXT,DIC,DIE,DN,DPK,DQ,DRN
- +4 KILL DIFQR,DNAME,DSEC,DTL,DIFC,Q,DIDIU,DIFKEP,DIT,DILN2
- QUIT
- +5 ;
- MEN ;add to menu
- +1 IF '$DATA(^ORD(101,+MEN,0))
- QUIT
- SET OMEN=$PIECE(^(0),"^")
- SET IT=$ORDER(^ORD(101,+MEN,10,"B",D,0))
- IF $DATA(^UTILITY(U,$JOB,X,D,"MEN",OMEN))
- QUIT
- SET ^UTILITY(U,$JOB,X,D,"MEN",OMEN)=$SELECT(IT:^ORD(101,+MEN,10,IT,0),1:D)
- +2 IF IT
- IF $PIECE(^ORD(101,+MEN,10,IT,0),"^",4)
- SET X0=$PIECE(^(0),"^",4)
- SET $PIECE(^(0),"^",4)=""
- IF $DATA(^ORD(101,X0,0))
- SET $PIECE(^UTILITY(U,$JOB,X,D,"MEN",OMEN),"^",4)=$PIECE(^(0),"^")
- +3 WRITE !,"Sending "_$PIECE(^ORD(101,D,0),"^")_" to go on "_$PIECE(^ORD(101,+MEN,0),"^")_" menu."
- +4 QUIT
- A2 IF %1'=DHS
- IF %3'?1"ORB".E
- KILL ^UTILITY(U,$JOB,X,D,10,%)
- SET CTR=CTR-1
- SET TOP=%
- QUIT
- +1 SET ^UTILITY(U,$JOB,X,D,10,%,U)=%3
- +2 IF $PIECE(%2,"^",4)
- IF $DATA(^ORD(101,$PIECE(%2,"^",4),0))
- SET $PIECE(^UTILITY(U,$JOB,X,D,10,%,0),"^",4)=$PIECE(^(0),"^")
- +3 QUIT
