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 ---[H[J[2J[HORVOM3 958 printed Oct 16, 2024@18:35:31 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 ;; ;
