- 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 Feb 19, 2025@00:01:29 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 ;; ;