- 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 Jan 18, 2025@03:31:33 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)