ORDV04 ; SLC/DAN/dcm - OE/RR ;7/21/04 15:32
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,148,160,208,195,241,215,274,256,243**;Dec 17,1997;Build 242
;OE/RR COMPONENT
;
; ^TMP("GMPLHS",$J) DBIA 1183
; ^UTILITY & ^TMP("GMRVD") DBIA 10061
;
ORC(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Current Orders
;Calls EN^ORQ1, ^OR(100
N ORCNT,ORJ,ORSITE,SITE,ORX0,ORLIST,GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORR",$J),^TMP("ORDATA",$J)
D @GO
I '$D(^TMP("ORR",$J)) Q
S ORCNT=0,ORJ=0
F S ORJ=$O(^TMP("ORR",$J,ORLIST,ORJ)) Q:'+ORJ!(ORCNT'<ORMAX) S ORX0=^(ORJ) D
. S ORCNT=ORCNT+1,SITE=$S($L($G(^TMP("ORR",$J,ORLIST,ORJ,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,ORLIST,ORJ,"WP",1)="1^"_SITE ;Station ID
. D SPMRG^ORDVU("^TMP(""ORR"","_$J_","""_ORLIST_""","_ORJ_",""TX"")","^TMP(""ORDATA"","_$J_","""_ORLIST_""","_ORJ_",""WP"",2)",2) ;order text
. S ^TMP("ORDATA",$J,ORLIST,ORJ,"WP",3)="3^"_$P(ORX0,"^",6) ; status
. S ^TMP("ORDATA",$J,ORLIST,ORJ,"WP",4)="4^"_$$DATE^ORDVU($P(ORX0,"^",4)) ;start date
. S ^TMP("ORDATA",$J,ORLIST,ORJ,"WP",5)="5^"_$$DATE^ORDVU($P(ORX0,"^",5)) ;stop date
. S ^TMP("ORDATA",$J,ORLIST,ORJ,"WP",7)="7^"_$P(^TMP("ORR",$J,ORLIST,ORJ),U) ;Order Number
. I $O(^TMP("ORR",$J,ORLIST,ORJ,"TX",1)) S ^TMP("ORDATA",$J,ORLIST,ORJ,"WP",6)="6^[+]" ;flag for details
K ^TMP("ORR",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
ORCVA ;Current Orders
N ORVP
S ORVP=DFN_";DPT("
I '$D(^OR(100,"AC",ORVP)) Q
D EN^ORQ1(ORVP,,2,,ORDBEG,ORDEND,1) ;get current orders. ORLIST is set in ORQ1
Q
PLAILALL(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Problem list API returns ALL problems
N GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
D PLAIL
Q
PLALL ;All Problems
D GETLIST^GMPLHS(DFN,"ALL")
Q
PLAILI(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Problem list API returns INACTIVE problems
N GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
D PLAIL
Q
PLI ;Inactive Problems
D GETLIST^GMPLHS(DFN,"I")
Q
PLAILA(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Problem list API returns ACTIVE problems
N GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
D PLAIL
Q
PLA ;Active Problems
D GETLIST^GMPLHS(DFN,"A")
Q
PLAIL ;problems(active, inactive or all)
;External calls to ^GMPLHS
; input:
; STATUS = "A" active problems
; STATUS = "I" inactive problems
; STATUS = "ALL" all problems
;
I $L($T(GCPR^OMGCOAS1)) D Q ; Call if FHIE station 200
. S ORDBEG=0,ORDEND=9999999,ORMAX=99999
. D GCPR^OMGCOAS1(DFN,"PLL",ORDBEG,ORDEND,ORMAX)
. S ROOT=$NA(^TMP("ORDATA",$J))
N ORPROBNO,ORXREC0,ORLOC,I,K,X,ORSITE,SITE,ORMORE
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J),^TMP("GMPLHS",$J) ;DBIA #1183
D @GO
I '$D(^TMP("GMPLHS",$J)) Q
S ORPROBNO=0
F I=1:1 S ORPROBNO=$O(^TMP("GMPLHS",$J,ORPROBNO)) Q:'ORPROBNO D
. S ORXREC0=$G(^TMP("GMPLHS",$J,ORPROBNO,0)),ORMORE=0
. S SITE=$S($L($G(^TMP("GMPLHS",$J,ORPROBNO,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,ORPROBNO,"WP",1)="1^"_SITE ;Station ID
. S ^TMP("ORDATA",$J,ORPROBNO,"WP",2)="2^"_$P(ORXREC0,U,5) ;status
. S ^TMP("ORDATA",$J,ORPROBNO,"WP",3)="3^"_$G(^TMP("GMPLHS",$J,ORPROBNO,"N")) ;provider narrative
. S ^TMP("ORDATA",$J,ORPROBNO,"WP",4)="4^"_$$DATE^ORDVU($P(ORXREC0,U,6)) ;onset date
. S ^TMP("ORDATA",$J,ORPROBNO,"WP",5)="5^"_$$DATE^ORDVU($P(ORXREC0,U,2)) ;last modified date
. S ^TMP("ORDATA",$J,ORPROBNO,"WP",6)="6^"_$P(ORXREC0,U,7) ;provider
. S ORLOC=0,K=0
. F S ORLOC=$O(^TMP("GMPLHS",$J,ORPROBNO,"C",ORLOC)) Q:'ORLOC D
.. S X=0
.. F S X=$O(^TMP("GMPLHS",$J,ORPROBNO,"C",ORLOC,X)) Q:'X D
... S K=K+1,ORMORE=1
... S ^TMP("ORDATA",$J,ORPROBNO,"WP",7,K)="7^"_$P($G(^TMP("GMPLHS",$J,ORPROBNO,"C",ORLOC,X,0)),U) ;note narrative
. S ^TMP("ORDATA",$J,ORPROBNO,"WP",8)="8^"_$P(ORXREC0,U,14) ;exposures
. I ORMORE S ^TMP("ORDATA",$J,ORPROBNO,"WP",9)="9^[+]" ;flag for details
K ^TMP("GMPLHS",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
SR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Surgery Report
;Call ^ORDV04A
N ORCNT
S ORCNT=0
K ^TMP("ORDATA",$J)
D ENSR^ORDV04A
S ROOT=$NA(^TMP("ORDATA",$J))
Q
VS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; get vital Signs
D VS^ORDV04A
Q
TIUPRG(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; TIU version of progress reports
;Calls to TIUSRVLO,TIUSRVR1,VASITE
I $L($T(GCPR^OMGCOAS1)) D Q ; Call if FHIE station 200
. D GCPR^OMGCOAS1(DFN,"PN",ORDBEG,ORDEND,ORMAX)
. S ROOT=$NA(^TMP("ORDATA",$J))
N ORDT,DATE,ORCI,ORGLOB,ORGLOBA,ORTEMP,ORSITE,SITE,I,ORNODE,GO,ORIMAG
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
D @GO
I '$D(@ORGLOB) Q
S ORNODE=0,ORCI=0
K ^TMP("ORDATA",$J)
F S ORNODE=$O(@ORGLOB@(ORNODE)) Q:'ORNODE!(ORCI'<ORMAX) D
. S ORTEMP=@ORGLOB@(ORNODE)
. S ORIMAG=$P($$RESOLVE^TIUSRVLO($P(ORTEMP,U)),U,10)
. S DATE=$P(ORTEMP,U,3) ;date
. S SITE=$S($L($G(@ORGLOB@(ORNODE,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,ORNODE,"WP",1)="1^"_SITE ;Station ID
. S ^TMP("ORDATA",$J,ORNODE,"WP",2)="2^"_$P(ORTEMP,U) ;TIU ien
. S ^TMP("ORDATA",$J,ORNODE,"WP",3)="3^"_$$DATE^ORDVU(DATE) ;date
. S ^TMP("ORDATA",$J,ORNODE,"WP",4)="4^"_$P(ORTEMP,U,2) ;type
. S ^TMP("ORDATA",$J,ORNODE,"WP",5)="5^"_$P($P(ORTEMP,U,5),";",2) ;author
. S ORCI=ORCI+1
. D TGET^TIUSRVR1(.ORGLOBA,$P(ORTEMP,U)) ;Call back to get note text
. D SPMRG^ORDVU($NA(@ORGLOBA),$NA(^TMP("ORDATA",$J,ORNODE,"WP",6)),6) ;Notes Text
. I $O(@ORGLOBA@(0)) S ^TMP("ORDATA",$J,ORNODE,"WP",7)="7^[+]"
. S ^TMP("ORDATA",$J,ORNODE,"WP",8)="8^"_ORIMAG
. K @ORGLOBA
K @ORGLOB
S ROOT=$NA(^TMP("ORDATA",$J))
Q
TPRG ;TIU Progress Notes
D CONTEXT^TIUSRVLO(.ORGLOB,3,5,DFN,ORDBEG,ORDEND,,ORMAX)
Q
TIUDCS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Discharge Summaries
;Calls VASITE, DIQ1, TIUSRVLO
I $L($T(GCPR^OMGCOAS1)) D Q ; Call if FHIE station 200
. D GCPR^OMGCOAS1(DFN,"DS",ORDBEG,ORDEND,ORMAX)
. S ROOT=$NA(^TMP("ORDATA",$J))
N ORGLOB,ORGLOBA,ORI,ORNODE,ORICDIEN,ORARRAY,ORTEMP,ORSITE,SITE,DIC,DR,DIQ,DA,GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
D @GO
I '$D(@ORGLOB) Q
K ^TMP("ORDATA",$J)
S ORNODE=0,ORI=0
F S ORNODE=$O(@ORGLOB@(ORNODE)) Q:'ORNODE!(ORI'<ORMAX) D
. S ORTEMP=@ORGLOB@(ORNODE)
. S SITE=$S($L($G(@ORGLOB@(ORNODE,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,ORNODE,"WP",1)="1^"_SITE ;Station ID
. K ORARRAY S DIC=8925,DA=$P(ORTEMP,U),DR=".05;.07;.08;1202;1502",DIQ="ORARRAY"
. D EN^DIQ1
. S DIQ="ORARRAY(8925,"_DA_")"
. S ^TMP("ORDATA",$J,ORNODE,"WP",2)="2^"_$$DATEMMM^ORDVU($G(@DIQ@(.07))) ;episode begin date/time
. S ^TMP("ORDATA",$J,ORNODE,"WP",3)="3^"_$$DATEMMM^ORDVU($G(@DIQ@(.08))) ;episode end date/time
. S ^TMP("ORDATA",$J,ORNODE,"WP",4)="4^"_$G(@DIQ@(1202)) ;author/dicator
. S ^TMP("ORDATA",$J,ORNODE,"WP",5)="5^"_$G(@DIQ@(1502)) ;signed by
. S ^TMP("ORDATA",$J,ORNODE,"WP",6)="6^"_$G(@DIQ@(.05)) ;status
. S ORI=ORI+1
. D TGET^TIUSRVR1(.ORGLOBA,$P(ORTEMP,U)) ;Call to get summary text
. D SPMRG^ORDVU($NA(@ORGLOBA),$NA(^TMP("ORDATA",$J,ORNODE,"WP",7)),7) ;summary Text
. I $O(@ORGLOBA@(0)) S ^TMP("ORDATA",$J,ORNODE,"WP",8)="8^[+]" ;detail flag
. K @ORGLOBA
K @ORGLOB
S ROOT=$NA(^TMP("ORDATA",$J))
Q
TDCS ;TIU Discharge Summary
D CONTEXT^TIUSRVLO(.ORGLOB,244,5,DFN,ORDBEG,ORDEND,,ORMAX)
Q
ORDV04 ; SLC/DAN/dcm - OE/RR ;7/21/04 15:32
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,148,160,208,195,241,215,274,256,243**;Dec 17,1997;Build 242
+2 ;OE/RR COMPONENT
+3 ;
+4 ; ^TMP("GMPLHS",$J) DBIA 1183
+5 ; ^UTILITY & ^TMP("GMRVD") DBIA 10061
+6 ;
ORC(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Current Orders
+1 ;Calls EN^ORQ1, ^OR(100
+2 NEW ORCNT,ORJ,ORSITE,SITE,ORX0,ORLIST,GO
+3 IF '$LENGTH(OREXT)
QUIT
+4 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+5 IF '$LENGTH($TEXT(@GO))
QUIT
+6 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+7 KILL ^TMP("ORR",$JOB),^TMP("ORDATA",$JOB)
+8 DO @GO
+9 IF '$DATA(^TMP("ORR",$JOB))
QUIT
+10 SET ORCNT=0
SET ORJ=0
+11 FOR
SET ORJ=$ORDER(^TMP("ORR",$JOB,ORLIST,ORJ))
IF '+ORJ!(ORCNT'<ORMAX)
QUIT
SET ORX0=^(ORJ)
Begin DoDot:1
+12 SET ORCNT=ORCNT+1
SET SITE=$SELECT($LENGTH($GET(^TMP("ORR",$JOB,ORLIST,ORJ,"facility"))):^("facility"),1:ORSITE)
+13 ;Station ID
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",1)="1^"_SITE
+14 ;order text
DO SPMRG^ORDVU("^TMP(""ORR"","_$JOB_","""_ORLIST_""","_ORJ_",""TX"")","^TMP(""ORDATA"","_$JOB_","""_ORLIST_""","_ORJ_",""WP"",2)",2)
+15 ; status
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",3)="3^"_$PIECE(ORX0,"^",6)
+16 ;start date
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",4)="4^"_$$DATE^ORDVU($PIECE(ORX0,"^",4))
+17 ;stop date
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",5)="5^"_$$DATE^ORDVU($PIECE(ORX0,"^",5))
+18 ;Order Number
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",7)="7^"_$PIECE(^TMP("ORR",$JOB,ORLIST,ORJ),U)
+19 ;flag for details
IF $ORDER(^TMP("ORR",$JOB,ORLIST,ORJ,"TX",1))
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",6)="6^[+]"
End DoDot:1
+20 KILL ^TMP("ORR",$JOB)
+21 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+22 QUIT
ORCVA ;Current Orders
+1 NEW ORVP
+2 SET ORVP=DFN_";DPT("
+3 IF '$DATA(^OR(100,"AC",ORVP))
QUIT
+4 ;get current orders. ORLIST is set in ORQ1
DO EN^ORQ1(ORVP,,2,,ORDBEG,ORDEND,1)
+5 QUIT
PLAILALL(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Problem list API returns ALL problems
+1 NEW GO
+2 IF '$LENGTH(OREXT)
QUIT
+3 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+4 IF '$LENGTH($TEXT(@GO))
QUIT
+5 DO PLAIL
+6 QUIT
PLALL ;All Problems
+1 DO GETLIST^GMPLHS(DFN,"ALL")
+2 QUIT
PLAILI(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Problem list API returns INACTIVE problems
+1 NEW GO
+2 IF '$LENGTH(OREXT)
QUIT
+3 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+4 IF '$LENGTH($TEXT(@GO))
QUIT
+5 DO PLAIL
+6 QUIT
PLI ;Inactive Problems
+1 DO GETLIST^GMPLHS(DFN,"I")
+2 QUIT
PLAILA(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Problem list API returns ACTIVE problems
+1 NEW GO
+2 IF '$LENGTH(OREXT)
QUIT
+3 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+4 IF '$LENGTH($TEXT(@GO))
QUIT
+5 DO PLAIL
+6 QUIT
PLA ;Active Problems
+1 DO GETLIST^GMPLHS(DFN,"A")
+2 QUIT
PLAIL ;problems(active, inactive or all)
+1 ;External calls to ^GMPLHS
+2 ; input:
+3 ; STATUS = "A" active problems
+4 ; STATUS = "I" inactive problems
+5 ; STATUS = "ALL" all problems
+6 ;
+7 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+8 SET ORDBEG=0
SET ORDEND=9999999
SET ORMAX=99999
+9 DO GCPR^OMGCOAS1(DFN,"PLL",ORDBEG,ORDEND,ORMAX)
+10 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
End DoDot:1
QUIT
+11 NEW ORPROBNO,ORXREC0,ORLOC,I,K,X,ORSITE,SITE,ORMORE
+12 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+13 ;DBIA #1183
KILL ^TMP("ORDATA",$JOB),^TMP("GMPLHS",$JOB)
+14 DO @GO
+15 IF '$DATA(^TMP("GMPLHS",$JOB))
QUIT
+16 SET ORPROBNO=0
+17 FOR I=1:1
SET ORPROBNO=$ORDER(^TMP("GMPLHS",$JOB,ORPROBNO))
IF 'ORPROBNO
QUIT
Begin DoDot:1
+18 SET ORXREC0=$GET(^TMP("GMPLHS",$JOB,ORPROBNO,0))
SET ORMORE=0
+19 SET SITE=$SELECT($LENGTH($GET(^TMP("GMPLHS",$JOB,ORPROBNO,"facility"))):^("facility"),1:ORSITE)
+20 ;Station ID
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",1)="1^"_SITE
+21 ;status
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",2)="2^"_$PIECE(ORXREC0,U,5)
+22 ;provider narrative
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",3)="3^"_$GET(^TMP("GMPLHS",$JOB,ORPROBNO,"N"))
+23 ;onset date
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",4)="4^"_$$DATE^ORDVU($PIECE(ORXREC0,U,6))
+24 ;last modified date
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",5)="5^"_$$DATE^ORDVU($PIECE(ORXREC0,U,2))
+25 ;provider
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",6)="6^"_$PIECE(ORXREC0,U,7)
+26 SET ORLOC=0
SET K=0
+27 FOR
SET ORLOC=$ORDER(^TMP("GMPLHS",$JOB,ORPROBNO,"C",ORLOC))
IF 'ORLOC
QUIT
Begin DoDot:2
+28 SET X=0
+29 FOR
SET X=$ORDER(^TMP("GMPLHS",$JOB,ORPROBNO,"C",ORLOC,X))
IF 'X
QUIT
Begin DoDot:3
+30 SET K=K+1
SET ORMORE=1
+31 ;note narrative
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",7,K)="7^"_$PIECE($GET(^TMP("GMPLHS",$JOB,ORPROBNO,"C",ORLOC,X,0)),U)
End DoDot:3
End DoDot:2
+32 ;exposures
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",8)="8^"_$PIECE(ORXREC0,U,14)
+33 ;flag for details
IF ORMORE
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",9)="9^[+]"
End DoDot:1
+34 KILL ^TMP("GMPLHS",$JOB)
+35 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+36 QUIT
SR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Surgery Report
+1 ;Call ^ORDV04A
+2 NEW ORCNT
+3 SET ORCNT=0
+4 KILL ^TMP("ORDATA",$JOB)
+5 DO ENSR^ORDV04A
+6 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+7 QUIT
VS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; get vital Signs
+1 DO VS^ORDV04A
+2 QUIT
TIUPRG(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; TIU version of progress reports
+1 ;Calls to TIUSRVLO,TIUSRVR1,VASITE
+2 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+3 DO GCPR^OMGCOAS1(DFN,"PN",ORDBEG,ORDEND,ORMAX)
+4 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
End DoDot:1
QUIT
+5 NEW ORDT,DATE,ORCI,ORGLOB,ORGLOBA,ORTEMP,ORSITE,SITE,I,ORNODE,GO,ORIMAG
+6 IF '$LENGTH(OREXT)
QUIT
+7 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+8 IF '$LENGTH($TEXT(@GO))
QUIT
+9 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+10 DO @GO
+11 IF '$DATA(@ORGLOB)
QUIT
+12 SET ORNODE=0
SET ORCI=0
+13 KILL ^TMP("ORDATA",$JOB)
+14 FOR
SET ORNODE=$ORDER(@ORGLOB@(ORNODE))
IF 'ORNODE!(ORCI'<ORMAX)
QUIT
Begin DoDot:1
+15 SET ORTEMP=@ORGLOB@(ORNODE)
+16 SET ORIMAG=$PIECE($$RESOLVE^TIUSRVLO($PIECE(ORTEMP,U)),U,10)
+17 ;date
SET DATE=$PIECE(ORTEMP,U,3)
+18 SET SITE=$SELECT($LENGTH($GET(@ORGLOB@(ORNODE,"facility"))):^("facility"),1:ORSITE)
+19 ;Station ID
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",1)="1^"_SITE
+20 ;TIU ien
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",2)="2^"_$PIECE(ORTEMP,U)
+21 ;date
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",3)="3^"_$$DATE^ORDVU(DATE)
+22 ;type
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",4)="4^"_$PIECE(ORTEMP,U,2)
+23 ;author
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",5)="5^"_$PIECE($PIECE(ORTEMP,U,5),";",2)
+24 SET ORCI=ORCI+1
+25 ;Call back to get note text
DO TGET^TIUSRVR1(.ORGLOBA,$PIECE(ORTEMP,U))
+26 ;Notes Text
DO SPMRG^ORDVU($NAME(@ORGLOBA),$NAME(^TMP("ORDATA",$JOB,ORNODE,"WP",6)),6)
+27 IF $ORDER(@ORGLOBA@(0))
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",7)="7^[+]"
+28 SET ^TMP("ORDATA",$JOB,ORNODE,"WP",8)="8^"_ORIMAG
+29 KILL @ORGLOBA
End DoDot:1
+30 KILL @ORGLOB
+31 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+32 QUIT
TPRG ;TIU Progress Notes
+1 DO CONTEXT^TIUSRVLO(.ORGLOB,3,5,DFN,ORDBEG,ORDEND,,ORMAX)
+2 QUIT
TIUDCS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Discharge Summaries
+1 ;Calls VASITE, DIQ1, TIUSRVLO
+2 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+3 DO GCPR^OMGCOAS1(DFN,"DS",ORDBEG,ORDEND,ORMAX)
+4 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
End DoDot:1
QUIT
+5 NEW ORGLOB,ORGLOBA,ORI,ORNODE,ORICDIEN,ORARRAY,ORTEMP,ORSITE,SITE,DIC,DR,DIQ,DA,GO
+6 IF '$LENGTH(OREXT)
QUIT
+7 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+8 IF '$LENGTH($TEXT(@GO))
QUIT
+9 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+10 DO @GO
+11 IF '$DATA(@ORGLOB)
QUIT
+12 KILL ^TMP("ORDATA",$JOB)
+13 SET ORNODE=0
SET ORI=0
+14 FOR
SET ORNODE=$ORDER(@ORGLOB@(ORNODE))
IF 'ORNODE!(ORI'<ORMAX)
QUIT
Begin DoDot:1
+15 SET ORTEMP=@ORGLOB@(ORNODE)
+16 SET SITE=$SELECT($LENGTH($GET(@ORGLOB@(ORNODE,"facility"))):^("facility"),1:ORSITE)
+17 ;Station ID
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",1)="1^"_SITE
+18 KILL ORARRAY
SET DIC=8925
SET DA=$PIECE(ORTEMP,U)
SET DR=".05;.07;.08;1202;1502"
SET DIQ="ORARRAY"
+19 DO EN^DIQ1
+20 SET DIQ="ORARRAY(8925,"_DA_")"
+21 ;episode begin date/time
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",2)="2^"_$$DATEMMM^ORDVU($GET(@DIQ@(.07)))
+22 ;episode end date/time
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",3)="3^"_$$DATEMMM^ORDVU($GET(@DIQ@(.08)))
+23 ;author/dicator
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",4)="4^"_$GET(@DIQ@(1202))
+24 ;signed by
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",5)="5^"_$GET(@DIQ@(1502))
+25 ;status
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",6)="6^"_$GET(@DIQ@(.05))
+26 SET ORI=ORI+1
+27 ;Call to get summary text
DO TGET^TIUSRVR1(.ORGLOBA,$PIECE(ORTEMP,U))
+28 ;summary Text
DO SPMRG^ORDVU($NAME(@ORGLOBA),$NAME(^TMP("ORDATA",$JOB,ORNODE,"WP",7)),7)
+29 ;detail flag
IF $ORDER(@ORGLOBA@(0))
SET ^TMP("ORDATA",$JOB,ORNODE,"WP",8)="8^[+]"
+30 KILL @ORGLOBA
End DoDot:1
+31 KILL @ORGLOB
+32 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+33 QUIT
TDCS ;TIU Discharge Summary
+1 DO CONTEXT^TIUSRVLO(.ORGLOB,244,5,DFN,ORDBEG,ORDEND,,ORMAX)
+2 QUIT
