ORVOM5.m

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 ---ORVOM5   985     printed  Mar 13, 2025@21:39: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 ;;