ORVOM5 ; slc/dcm - ONIT creation ;1/14/91 09:55 ;
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
S Q=1 K ^UTILITY($J)
S X="T",%DT="" D ^%DT
S Y=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" "_$S(Y#100:$J(Y#100\1,2)_",",1:"")_(Y\10000+1700)_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12),1:"")
S DRN=17,DIRS=" S DIFQ=1"
S X=0
S F=0 F S F=$O(F(F)) Q:F="" S X=X+1,DH=$P(@(F(F,0)_"0)"),U,2),^UTILITY($J,27+X,0)=" ;;"_DH_";"_F(F)_";"_$S($D(DTL(F)):DTL(F)+1,1:0)_";"_F(F,0)_";"_$S($D(F(F,F)):F(F,F),1:"")
S ^UTILITY($J,9,0)=" L W !"_$S(Q:",$C(7),""OK, Protocol Installation is Complete."",!",1:"")_$S(Q:"",1:" D ^"_Q)
S ^UTILITY($J,9.3,0)=" K %ZW,%,%H,D0,DA,DIF,DIFQ,DIG,DIH,DIK,DIU,DIV,DSEC,I,J,KEY,DIY,N,NM,NO,ORVROM,R,X,X0"
S ^UTILITY($J,9.5,0)=" Q"
F D=1:1 S E=$P($T(T+D),";",3,999) Q:E="" S:E="IXF ;;" E=E_DTL S ^UTILITY($J,9+D,0)=E,ORVROM=X+3
G ^ORVOM6
T ;
;; ;
;;Q W $C(7),!!,"NO UPDATING HAS OCCURRED!" Q
;; ;
;;IXF ;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORVOM5 985 printed Dec 13, 2024@02:34:58 Page 2
ORVOM5 ; slc/dcm - ONIT creation ;1/14/91 09:55 ;
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
+2 SET Q=1
KILL ^UTILITY($JOB)
+3 SET X="T"
SET %DT=""
DO ^%DT
+4 SET Y=$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$EXTRACT(Y,4,5))_" "_$SELECT(Y#100:$JUSTIFY(Y#100\1,2)_",",1:"")_(Y\10000+1700)_$SELECT(Y#1:" "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12),1:"")
+5 SET DRN=17
SET DIRS=" S DIFQ=1"
+6 SET X=0
+7 SET F=0
FOR
SET F=$ORDER(F(F))
if F=""
QUIT
SET X=X+1
SET DH=$PIECE(@(F(F,0)_"0)"),U,2)
SET ^UTILITY($JOB,27+X,0)=" ;;"_DH_";"_F(F)_";"_$SELECT($DATA(DTL(F)):DTL(F)+1,1:0)_";"_F(F,0)_";"_$SELECT($DATA(F(F,F)):F(F,F),1:"")
+8 SET ^UTILITY($JOB,9,0)=" L W !"_$SELECT(Q:",$C(7),""OK, Protocol Installation is Complete."",!",1:"")_$SELECT(Q:"",1:" D ^"_Q)
+9 SET ^UTILITY($JOB,9.3,0)=" K %ZW,%,%H,D0,DA,DIF,DIFQ,DIG,DIH,DIK,DIU,DIV,DSEC,I,J,KEY,DIY,N,NM,NO,ORVROM,R,X,X0"
+10 SET ^UTILITY($JOB,9.5,0)=" Q"
+11 FOR D=1:1
SET E=$PIECE($TEXT(T+D),";",3,999)
if E=""
QUIT
if E="IXF ;;"
SET E=E_DTL
SET ^UTILITY($JOB,9+D,0)=E
SET ORVROM=X+3
+12 GOTO ^ORVOM6
T ;
+1 ;; ;
+2 ;;Q W $C(7),!!,"NO UPDATING HAS OCCURRED!" Q
+3 ;; ;
+4 ;;IXF ;;
