- ORDV08 ;DAN/SLC Testing new component ;8/22/01 11:30
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,243**;Dec 17,1997;Build 242
- ;
- RIM(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology report
- ;External Calls: MAIN^GMTSRAE(2),RPT^ORWRA
- N ORX0,ORCNT,ORSITE,SITE,GO,ORMORE,ORROOT
- Q:'$L(OREXT)
- S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
- Q:'$L($T(@GO))
- K ^TMP("ORDATA",$J),^TMP("ORXPND",$J)
- S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
- D @GO
- S ORCNT=0
- F S ORCNT=$O(^TMP($J,"ORAEXAMS",ORCNT)) Q:'ORCNT D
- . S ORMORE=0
- . S ORX0=$G(^TMP($J,"ORAEXAMS",ORCNT))
- . D RPT^ORWRA(.ORROOT,DFN,$P(ORX0,U))
- . S SITE=$S($L($G(^TMP($J,"ORAEXAMS",ORCNT,"facility"))):^("facility"),1:ORSITE)
- . S ^TMP("ORDATA",$J,ORCNT,"WP",1)="1^"_SITE ;Site ID
- . S ^TMP("ORDATA",$J,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($P(ORX0,U,2)) ;date
- . S ^TMP("ORDATA",$J,ORCNT,"WP",3)="3^"_$P(ORX0,U,3) ;procedure
- . S ^TMP("ORDATA",$J,ORCNT,"WP",4)="4^"_$P(ORX0,U,5) ;report status
- . S ^TMP("ORDATA",$J,ORCNT,"WP",5)="5^"_$P(ORX0,U,4) ;Case #
- . I $O(^TMP("ORXPND",$J,0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("ORXPND",$J)),$NA(^TMP("ORDATA",$J,ORCNT,"WP",6,1)),6) ;clinical history
- . I ORMORE S ^TMP("ORDATA",$J,ORCNT,"WP",7)="7^[+]" ;flag for detail
- . S ^TMP("ORDATA",$J,ORCNT,"WP",8)="8^"_$P(ORX0,U,14) ;Image available
- . S ^TMP("ORDATA",$J,ORCNT,"WP",9)="9^"_"i"_$P(ORX0,U,1) ;EXAM ID
- K ^TMP("RAE",$J),^TMP("ORXPND",$J)
- S ROOT=$NA(^TMP("ORDATA",$J))
- Q
- ;
- IGET ;Get imaging exams
- N ORROOT,ORRADATA,I,ID
- S ORRADATA=$NA(^TMP($J,"RAE1",DFN))
- S ORROOT=$NA(^TMP($J,"ORAEXAMS"))
- K @ORRADATA,@ORROOT
- D EN1^RAO7PC1(DFN,ORDBEG,ORDEND,ORMAX) ;call to Radiology to get exams
- S I=0,ID=""
- F S ID=$O(@ORRADATA@(ID)) Q:ID="" D
- . S I=I+1
- . S @ORROOT@(I)=ID_U_(9999999.9999-ID)_U_@ORRADATA@(ID)
- K @ORRADATA
- Q
- ;
- MPRO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Medicine Procedures
- N ORSITE,ORI,ORREC,ORMORE,ORDATE,SITE,ORARRAY,ORPROC,ORSUM
- Q:'$L(OREXT)
- S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
- Q:'$L($T(@GO))
- K ^TMP("ORDATA",$J),^TMP("ORTEMP",$J),^TMP("MCAR",$J)
- S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
- D @GO
- S ORI=0
- F S ORI=$O(^TMP("MCAR",$J,ORI)) Q:'ORI!(ORI>ORMAX) D
- .K ^TMP("ORTEMP",$J) D GETREC^ORDV08A(ORI,80,20,56,3)
- .S SITE=$S($L($G(^TMP("MCAR",$J,ORI,"facility"))):^("facility"),1:ORSITE)
- .S ^TMP("ORDATA",$J,ORI,"WP",1)="1^"_SITE ;Site ID
- .S ^TMP("ORDATA",$J,ORI,"WP",2)="2^"_$$DATEMMM^ORDVU(ORDATE) ;Procedure date/time
- .S ^TMP("ORDATA",$J,ORI,"WP",3)="3^"_ORPROC ;Procedure Name
- .S ^TMP("ORDATA",$J,ORI,"WP",4)="4^"_$S(ORSUM'="":ORSUM,1:"No Summary") ;Summary
- .I $D(^TMP("ORTEMP",$J)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("ORTEMP",$J)),$NA(^TMP("ORDATA",$J,ORI,"WP",5,1)),5) ;Detailed Report
- .I ORMORE S ^TMP("ORDATA",$J,ORI,"WP",6)="6^[+]" ;Detailed report flag
- .Q
- K ^TMP("ORTEMP",$J),^TMP("MCAR",$J)
- S ROOT=$NA(^TMP("ORDATA",$J))
- Q
- MGET ;Get medicine results
- D HSUM^GMTSMCMA(DFN,ORDBEG,ORDEND,ORMAX,"","F")
- Q
- DIETNS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Nutrition assessment
- ;External Calls:SITE^VASITE, NUTR^ORWRP1, LISTNUTR^ORWPR1,FMTE^XLFDT
- N ORSITE,ORARRAY,ORID,ORCNT,ORMORE,GO,ORDT
- Q:'$L(OREXT)
- S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
- Q:'$L($T(@GO))
- K ^TMP("ORDATA",$J),^TMP("ORXPND",$J)
- S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
- D @GO
- S ORCNT=0,ORDT=OROMEGA
- F S ORDT=$O(^TMP($J,"FHADT",DFN,ORDT)) Q:(ORDT'>0)!(ORDT>ORALPHA)!(ORCNT>ORMAX) D
- . S ORID=$$FMTE^XLFDT(9999999-ORDT,2) ;convert inverse date to external date
- . S ORCNT=ORCNT+1,ORMORE=0
- . D NUTR^ORWRP1(.ORARRAY,DFN,ORID)
- . S ORSITE=$S($L($G(^TMP($J,"FHADT",ORDT,"facility"))):^("facility"),1:ORSITE)
- . S ^TMP("ORDATA",$J,ORCNT,"WP",1)="1^"_ORSITE ;Site ID
- . S ^TMP("ORDATA",$J,ORCNT,"WP",2)="2^"_ORID ;assessment date/time
- . I $O(^TMP("ORXPND",$J,0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("ORXPND",$J)),$NA(^TMP("ORDATA",$J,ORCNT,"WP",3,1)),3) ;assessment report
- . I ORMORE S ^TMP("ORDATA",$J,ORCNT,"WP",4)="4^[+]" ;flag for detail
- K ^TMP($J,"FHADT"),^TMP("ORXPND",$J)
- S ROOT=$NA(^TMP("ORDATA",$J))
- Q
- ;
- GETNS ;Get nutritional assessments
- D LISTNUTR^ORWRP1(.ORARRAY,DFN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV08 4261 printed Jan 18, 2025@03:31:30 Page 2
- ORDV08 ;DAN/SLC Testing new component ;8/22/01 11:30
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,243**;Dec 17,1997;Build 242
- +2 ;
- RIM(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology report
- +1 ;External Calls: MAIN^GMTSRAE(2),RPT^ORWRA
- +2 NEW ORX0,ORCNT,ORSITE,SITE,GO,ORMORE,ORROOT
- +3 if '$LENGTH(OREXT)
- QUIT
- +4 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
- +5 if '$LENGTH($TEXT(@GO))
- QUIT
- +6 KILL ^TMP("ORDATA",$JOB),^TMP("ORXPND",$JOB)
- +7 SET ORSITE=$$SITE^VASITE
- SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
- +8 DO @GO
- +9 SET ORCNT=0
- +10 FOR
- SET ORCNT=$ORDER(^TMP($JOB,"ORAEXAMS",ORCNT))
- if 'ORCNT
- QUIT
- Begin DoDot:1
- +11 SET ORMORE=0
- +12 SET ORX0=$GET(^TMP($JOB,"ORAEXAMS",ORCNT))
- +13 DO RPT^ORWRA(.ORROOT,DFN,$PIECE(ORX0,U))
- +14 SET SITE=$SELECT($LENGTH($GET(^TMP($JOB,"ORAEXAMS",ORCNT,"facility"))):^("facility"),1:ORSITE)
- +15 ;Site ID
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",1)="1^"_SITE
- +16 ;date
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($PIECE(ORX0,U,2))
- +17 ;procedure
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",3)="3^"_$PIECE(ORX0,U,3)
- +18 ;report status
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",4)="4^"_$PIECE(ORX0,U,5)
- +19 ;Case #
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",5)="5^"_$PIECE(ORX0,U,4)
- +20 ;clinical history
- IF $ORDER(^TMP("ORXPND",$JOB,0))
- SET ORMORE=1
- DO SPMRG^ORDVU($NAME(^TMP("ORXPND",$JOB)),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",6,1)),6)
- +21 ;flag for detail
- IF ORMORE
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",7)="7^[+]"
- +22 ;Image available
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",8)="8^"_$PIECE(ORX0,U,14)
- +23 ;EXAM ID
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",9)="9^"_"i"_$PIECE(ORX0,U,1)
- End DoDot:1
- +24 KILL ^TMP("RAE",$JOB),^TMP("ORXPND",$JOB)
- +25 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
- +26 QUIT
- +27 ;
- IGET ;Get imaging exams
- +1 NEW ORROOT,ORRADATA,I,ID
- +2 SET ORRADATA=$NAME(^TMP($JOB,"RAE1",DFN))
- +3 SET ORROOT=$NAME(^TMP($JOB,"ORAEXAMS"))
- +4 KILL @ORRADATA,@ORROOT
- +5 ;call to Radiology to get exams
- DO EN1^RAO7PC1(DFN,ORDBEG,ORDEND,ORMAX)
- +6 SET I=0
- SET ID=""
- +7 FOR
- SET ID=$ORDER(@ORRADATA@(ID))
- if ID=""
- QUIT
- Begin DoDot:1
- +8 SET I=I+1
- +9 SET @ORROOT@(I)=ID_U_(9999999.9999-ID)_U_@ORRADATA@(ID)
- End DoDot:1
- +10 KILL @ORRADATA
- +11 QUIT
- +12 ;
- MPRO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Medicine Procedures
- +1 NEW ORSITE,ORI,ORREC,ORMORE,ORDATE,SITE,ORARRAY,ORPROC,ORSUM
- +2 if '$LENGTH(OREXT)
- QUIT
- +3 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
- +4 if '$LENGTH($TEXT(@GO))
- QUIT
- +5 KILL ^TMP("ORDATA",$JOB),^TMP("ORTEMP",$JOB),^TMP("MCAR",$JOB)
- +6 SET ORSITE=$$SITE^VASITE
- SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
- +7 DO @GO
- +8 SET ORI=0
- +9 FOR
- SET ORI=$ORDER(^TMP("MCAR",$JOB,ORI))
- if 'ORI!(ORI>ORMAX)
- QUIT
- Begin DoDot:1
- +10 KILL ^TMP("ORTEMP",$JOB)
- DO GETREC^ORDV08A(ORI,80,20,56,3)
- +11 SET SITE=$SELECT($LENGTH($GET(^TMP("MCAR",$JOB,ORI,"facility"))):^("facility"),1:ORSITE)
- +12 ;Site ID
- SET ^TMP("ORDATA",$JOB,ORI,"WP",1)="1^"_SITE
- +13 ;Procedure date/time
- SET ^TMP("ORDATA",$JOB,ORI,"WP",2)="2^"_$$DATEMMM^ORDVU(ORDATE)
- +14 ;Procedure Name
- SET ^TMP("ORDATA",$JOB,ORI,"WP",3)="3^"_ORPROC
- +15 ;Summary
- SET ^TMP("ORDATA",$JOB,ORI,"WP",4)="4^"_$SELECT(ORSUM'="":ORSUM,1:"No Summary")
- +16 ;Detailed Report
- IF $DATA(^TMP("ORTEMP",$JOB))
- SET ORMORE=1
- DO SPMRG^ORDVU($NAME(^TMP("ORTEMP",$JOB)),$NAME(^TMP("ORDATA",$JOB,ORI,"WP",5,1)),5)
- +17 ;Detailed report flag
- IF ORMORE
- SET ^TMP("ORDATA",$JOB,ORI,"WP",6)="6^[+]"
- +18 QUIT
- End DoDot:1
- +19 KILL ^TMP("ORTEMP",$JOB),^TMP("MCAR",$JOB)
- +20 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
- +21 QUIT
- MGET ;Get medicine results
- +1 DO HSUM^GMTSMCMA(DFN,ORDBEG,ORDEND,ORMAX,"","F")
- +2 QUIT
- DIETNS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Nutrition assessment
- +1 ;External Calls:SITE^VASITE, NUTR^ORWRP1, LISTNUTR^ORWPR1,FMTE^XLFDT
- +2 NEW ORSITE,ORARRAY,ORID,ORCNT,ORMORE,GO,ORDT
- +3 if '$LENGTH(OREXT)
- QUIT
- +4 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
- +5 if '$LENGTH($TEXT(@GO))
- QUIT
- +6 KILL ^TMP("ORDATA",$JOB),^TMP("ORXPND",$JOB)
- +7 SET ORSITE=$$SITE^VASITE
- SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
- +8 DO @GO
- +9 SET ORCNT=0
- SET ORDT=OROMEGA
- +10 FOR
- SET ORDT=$ORDER(^TMP($JOB,"FHADT",DFN,ORDT))
- if (ORDT'>0)!(ORDT>ORALPHA)!(ORCNT>ORMAX)
- QUIT
- Begin DoDot:1
- +11 ;convert inverse date to external date
- SET ORID=$$FMTE^XLFDT(9999999-ORDT,2)
- +12 SET ORCNT=ORCNT+1
- SET ORMORE=0
- +13 DO NUTR^ORWRP1(.ORARRAY,DFN,ORID)
- +14 SET ORSITE=$SELECT($LENGTH($GET(^TMP($JOB,"FHADT",ORDT,"facility"))):^("facility"),1:ORSITE)
- +15 ;Site ID
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",1)="1^"_ORSITE
- +16 ;assessment date/time
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",2)="2^"_ORID
- +17 ;assessment report
- IF $ORDER(^TMP("ORXPND",$JOB,0))
- SET ORMORE=1
- DO SPMRG^ORDVU($NAME(^TMP("ORXPND",$JOB)),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",3,1)),3)
- +18 ;flag for detail
- IF ORMORE
- SET ^TMP("ORDATA",$JOB,ORCNT,"WP",4)="4^[+]"
- End DoDot:1
- +19 KILL ^TMP($JOB,"FHADT"),^TMP("ORXPND",$JOB)
- +20 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
- +21 QUIT
- +22 ;
- GETNS ;Get nutritional assessments
- +1 DO LISTNUTR^ORWRP1(.ORARRAY,DFN)
- +2 QUIT