ORVOM3.m

ORVOM3 ; slc/dcm - Creates rtn ending in 'ONIT2' ;1/23/91  07:15

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

 S DNAME=E_2,DL=0,(DH,Q)=" ;" K ^UTILITY($J) F DD=1:1 S X=$P($T(TEXT+DD),";",3,999) Q:X=""  S ^UTILITY($J,DD,0)=X,ORVROM=2

 D ZI G ^ORVOM4 ;cu

 ;

FILE ;

 S DL=0,Q="Q Q",S=" ;;"

NAME S D=$L(DH)+10,DNAME=DN_$E(DRN,2,4)

ZI ;

 I '$D(DIFROM(1)) S %H=+$H D YX^%DTC S DIFROM(1)=$E(Y,5,6)_"-"_$E(Y,1,3)_"-"_$E(Y,9,12)

2 K ^UTILITY($J,0) S ^(0,1)=DNAME_" ; ; "_DIFROM(1),^(1.1)=DILN2

 S ^UTILITY($J,0,2)=DH,^UTILITY($J,0,3)=Q F L=4:1 S DL=$O(^UTILITY($J,DL)) Q:DL=""  S ^UTILITY($J,0,L)=S_^(DL,0),D=$L(^(L))+D I D+380>DIFRM,$E(^(L),4)'="^",$E(^(L),4)'=$C(126) Q

 S DRN=DRN+1,X=DNAME X ^DD("OS",DISYS,"ZS") W !,X_" HAS BEEN FILED..." G NAME:DL>0

K K %A,%B,%C,%Z,^UTILITY($J) S DL=0 Q

 ;

TEXT ;

 ;; K ^UTILITY("ORVROM",$J),DIC

 ;; Q

 ;;DT W !

 ;; I '$D(DTIME) S DTIME=999

 ;; K %DT D NOW^%DTC S DT=X

 ;; K DIK,DIC,%I,DICS Q

 ;; ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORVOM3   958     printed  Apr 09, 2024@21:28:02                                                                                                                                                                                                       Page 2

ORVOM3    ; slc/dcm - Creates rtn ending in 'ONIT2' ;1/23/91  07:15

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

 +2        SET DNAME=E_2

           SET DL=0

           SET (DH,Q)=" ;"

           KILL ^UTILITY($JOB)

           FOR DD=1:1

               SET X=$PIECE($TEXT(TEXT+DD),";",3,999)

               if X=""

                   QUIT 

               SET ^UTILITY($JOB,DD,0)=X

               SET ORVROM=2

 +3       ;cu

           DO ZI

           GOTO ^ORVOM4

 +4       ;

FILE      ;

 +1        SET DL=0

           SET Q="Q Q"

           SET S=" ;;"

NAME       SET D=$LENGTH(DH)+10

           SET DNAME=DN_$EXTRACT(DRN,2,4)

ZI        ;

 +1        IF '$DATA(DIFROM(1))

               SET %H=+$HOROLOG

               DO YX^%DTC

               SET DIFROM(1)=$EXTRACT(Y,5,6)_"-"_$EXTRACT(Y,1,3)_"-"_$EXTRACT(Y,9,12)

2          KILL ^UTILITY($JOB,0)

           SET ^(0,1)=DNAME_" ; ; "_DIFROM(1)

           SET ^(1.1)=DILN2

 +1        SET ^UTILITY($JOB,0,2)=DH

           SET ^UTILITY($JOB,0,3)=Q

           FOR L=4:1

               SET DL=$ORDER(^UTILITY($JOB,DL))

               if DL=""

                   QUIT 

               SET ^UTILITY($JOB,0,L)=S_^(DL,0)

               SET D=$LENGTH(^(L))+D

               IF D+380>DIFRM

                   IF $EXTRACT(^(L),4)'="^"

                       IF $EXTRACT(^(L),4)'=$CHAR(126)

                           QUIT 

 +2        SET DRN=DRN+1

           SET X=DNAME

           XECUTE ^DD("OS",DISYS,"ZS")

           WRITE !,X_" HAS BEEN FILED..."

           if DL>0

               GOTO NAME

K          KILL %A,%B,%C,%Z,^UTILITY($JOB)

           SET DL=0

           QUIT 

 +1       ;

TEXT      ;

 +1       ;; K ^UTILITY("ORVROM",$J),DIC

 +2       ;; Q

 +3       ;;DT W !

 +4       ;; I '$D(DTIME) S DTIME=999

 +5       ;; K %DT D NOW^%DTC S DT=X

 +6       ;; K DIK,DIC,%I,DICS Q

 +7       ;; ;