ORDVU ; slc/dcm - OE/RR Report Extracts ; 08 May 2001 13:32PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109**;Dec 17, 1997
DATEMMM(X) ;convert date from MMM DD, YYYY to MM/DD/YYYY format
; e.g. convert JUL 04, 1998 to 07/04/1998
;
Q:$G(X)="" ""
N ORA
D DT^DILF("TS",X,.ORA) ; change date to FM internal format.
K ^TMP("DIERR",$J) ; this global may have been created by DT^DILF
S:$G(ORA)=-1 ORA=""
Q $$DATE(ORA)
DATE(X) ;convert fm date to readable format with 4 digits in year.
N ORX,YY
S ORX=X
S X=$$REGDTM4(X)
Q X
MERG(SOURCE,TARGET,MULT) ;merge and format WP fields
;Input:
; SOURCE = source global node
; TARGET= Target global node
; MULT = 1 for multiple fields (e.g. for multiple specimens
; each specimen will be separated by ", "
;
N ORI,ORSUB
S MULT=+$G(MULT)
I '$D(@SOURCE) Q
S ORSUB=SOURCE
S SOURCE=$E(SOURCE,1,$L(SOURCE)-1)_"," ;replace the closing ")" with ","
F ORI=1:1 S ORSUB=$Q(@ORSUB) Q:$E(ORSUB,1,$L(SOURCE))'=SOURCE D
.I 'MULT S @TARGET@(ORI)=@ORSUB_"<BR>" Q
.I MULT D
..I ORI'=1 S @TARGET@(ORI)=", "_@ORSUB
..E S @TARGET@(ORI)=@ORSUB ; before the first multiple do not put
Q
SPMRG(SOURCE,TARGET,ID) ;merge and format WP fields
;Input:
; SOURCE = source global node
; TARGET= Target global node
; ID = Column # associated with this data
;
N I,SUB
I '$D(@SOURCE) Q
S SUB=SOURCE
S SOURCE=$E(SOURCE,1,$L(SOURCE)-1)_"," ;replace the closing ")" with ","
F I=1:1 S SUB=$Q(@SUB) Q:$E(SUB,1,$L(SOURCE))'=SOURCE D
. S @TARGET@(I)=$G(ID)_"^"_@SUB Q
Q
REGDT(X) ; Receives X in internal date.time, and returns X in MM/DD/YY format
; DBIA 10103 call $$FMTE^XLFDT
Q $TR($$FMTE^XLFDT(X,"2DZ"),"@"," ")
REGDT4(X) ; Receives X in internal date.time, and returns X in MM/DD/YYYY format
; DBIA 10103 call $$FMTE^XLFDT
Q $TR($$FMTE^XLFDT(X,"5DZ"),"@"," ")
REGDTM(X) ;Receives X in internal date.time, and returns X in MM/DD/YY TT:TT
; DBIA 10103 call $$FMTE^XLFDT
Q $TR($$FMTE^XLFDT(X,"2ZM"),"@"," ")
REGDTM4(X) ;Receives X in internal date.time, and returns X in MM/DD/YYYY TT:TT
; DBIA 10103 call $$FMTE^XLFDT
Q $TR($$FMTE^XLFDT(X,"5ZM"),"@"," ")
SIDT(X) ; Receives X as internal date/time and returns X in DD MMM YY
N MON,MM
S X=$P(X,".") I 'X S X="" Q
S MON="JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"
S MM=$E(X,4,5),MM=$S(MM:$P(MON,U,MM),1:"")
Q $E(X,6,7)_" "_MM_" "_$E(X,2,3)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDVU 2448 printed Dec 13, 2024@02:30:23 Page 2
ORDVU ; slc/dcm - OE/RR Report Extracts ; 08 May 2001 13:32PM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109**;Dec 17, 1997
DATEMMM(X) ;convert date from MMM DD, YYYY to MM/DD/YYYY format
+1 ; e.g. convert JUL 04, 1998 to 07/04/1998
+2 ;
+3 if $GET(X)=""
QUIT ""
+4 NEW ORA
+5 ; change date to FM internal format.
DO DT^DILF("TS",X,.ORA)
+6 ; this global may have been created by DT^DILF
KILL ^TMP("DIERR",$JOB)
+7 if $GET(ORA)=-1
SET ORA=""
+8 QUIT $$DATE(ORA)
DATE(X) ;convert fm date to readable format with 4 digits in year.
+1 NEW ORX,YY
+2 SET ORX=X
+3 SET X=$$REGDTM4(X)
+4 QUIT X
MERG(SOURCE,TARGET,MULT) ;merge and format WP fields
+1 ;Input:
+2 ; SOURCE = source global node
+3 ; TARGET= Target global node
+4 ; MULT = 1 for multiple fields (e.g. for multiple specimens
+5 ; each specimen will be separated by ", "
+6 ;
+7 NEW ORI,ORSUB
+8 SET MULT=+$GET(MULT)
+9 IF '$DATA(@SOURCE)
QUIT
+10 SET ORSUB=SOURCE
+11 ;replace the closing ")" with ","
SET SOURCE=$EXTRACT(SOURCE,1,$LENGTH(SOURCE)-1)_","
+12 FOR ORI=1:1
SET ORSUB=$QUERY(@ORSUB)
if $EXTRACT(ORSUB,1,$LENGTH(SOURCE))'=SOURCE
QUIT
Begin DoDot:1
+13 IF 'MULT
SET @TARGET@(ORI)=@ORSUB_"<BR>"
QUIT
+14 IF MULT
Begin DoDot:2
+15 IF ORI'=1
SET @TARGET@(ORI)=", "_@ORSUB
+16 ; before the first multiple do not put
IF '$TEST
SET @TARGET@(ORI)=@ORSUB
End DoDot:2
End DoDot:1
+17 QUIT
SPMRG(SOURCE,TARGET,ID) ;merge and format WP fields
+1 ;Input:
+2 ; SOURCE = source global node
+3 ; TARGET= Target global node
+4 ; ID = Column # associated with this data
+5 ;
+6 NEW I,SUB
+7 IF '$DATA(@SOURCE)
QUIT
+8 SET SUB=SOURCE
+9 ;replace the closing ")" with ","
SET SOURCE=$EXTRACT(SOURCE,1,$LENGTH(SOURCE)-1)_","
+10 FOR I=1:1
SET SUB=$QUERY(@SUB)
if $EXTRACT(SUB,1,$LENGTH(SOURCE))'=SOURCE
QUIT
Begin DoDot:1
+11 SET @TARGET@(I)=$GET(ID)_"^"_@SUB
QUIT
End DoDot:1
+12 QUIT
REGDT(X) ; Receives X in internal date.time, and returns X in MM/DD/YY format
+1 ; DBIA 10103 call $$FMTE^XLFDT
+2 QUIT $TRANSLATE($$FMTE^XLFDT(X,"2DZ"),"@"," ")
REGDT4(X) ; Receives X in internal date.time, and returns X in MM/DD/YYYY format
+1 ; DBIA 10103 call $$FMTE^XLFDT
+2 QUIT $TRANSLATE($$FMTE^XLFDT(X,"5DZ"),"@"," ")
REGDTM(X) ;Receives X in internal date.time, and returns X in MM/DD/YY TT:TT
+1 ; DBIA 10103 call $$FMTE^XLFDT
+2 QUIT $TRANSLATE($$FMTE^XLFDT(X,"2ZM"),"@"," ")
REGDTM4(X) ;Receives X in internal date.time, and returns X in MM/DD/YYYY TT:TT
+1 ; DBIA 10103 call $$FMTE^XLFDT
+2 QUIT $TRANSLATE($$FMTE^XLFDT(X,"5ZM"),"@"," ")
SIDT(X) ; Receives X as internal date/time and returns X in DD MMM YY
+1 NEW MON,MM
+2 SET X=$PIECE(X,".")
IF 'X
SET X=""
QUIT
+3 SET MON="JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"
+4 SET MM=$EXTRACT(X,4,5)
SET MM=$SELECT(MM:$PIECE(MON,U,MM),1:"")
+5 QUIT $EXTRACT(X,6,7)_" "_MM_" "_$EXTRACT(X,2,3)
