ORDV04 ; SLC/DAN - OE/RR Components ;10/02/14 08:08
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,148,160,208,195,241,215,274,256,243,306,361,395**;Dec 17,1997;Build 11
;
; ^TMP("GMPLHS",$J) DBIA 1183
; ^UTILITY & ^TMP("GMRVD") DBIA 10061
;
ORC(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Current Orders
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) ; current orders. ORLIST is set in ORQ1
Q
PLAILALL(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; API - 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) ; API - 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) ; API - 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)
;Ext call: GMPLHS
; input:
; STATUS = "A" => active
; STATUS = "I" => inactive
; STATUS = "ALL" => all
;
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,ORLOC,I,ORSITE
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
. N ORXREC0,SITE,ICD,SCTC,VHATC,PROVNARR,ORMORE,K,ORCSYS,ORICDLBL
. S ORXREC0=$G(^TMP("GMPLHS",$J,ORPROBNO,0)),ORMORE=0
. S SITE=$S($L($G(^TMP("GMPLHS",$J,ORPROBNO,"facility"))):^("facility"),1:ORSITE)
. S ICD=$P(ORXREC0,U,17),SCTC=$P(ORXREC0,U,15),VHATC=$P(ORXREC0,U,19)
. S ORCSYS=$P(ORXREC0,U,22),ORICDLBL=$S(ORCSYS="10D":"ICD-10-CM",1:"ICD-9-CM")
. S PROVNARR=$P($G(^TMP("GMPLHS",$J,ORPROBNO,"N"))," (")
. S PROVNARR=PROVNARR_$S($L($G(ICD))&('$L($G(SCTC))&'$L($G(VHATC))):" ("_$G(ORICDLBL)_" "_$G(ICD)_")",$L($G(SCTC))&($L($G(ICD))):" (SCT "_$G(SCTC)_")"_" ("_$G(ORICDLBL)_" "_$G(ICD)_")",$L($G(VHATC)):" (VHAT "_$G(VHATC)_")",1:"")
. 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^"_PROVNARR ;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
.. N X 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
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) ; progress notes
;Ext calls: 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 ; Progress Notes
D CONTEXT^TIUSRVLO(.ORGLOB,3,5,DFN,ORDBEG,ORDEND,,ORMAX)
Q
TIUDCS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Discharge Summaries
;Ext 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 ; Discharge Summary
D CONTEXT^TIUSRVLO(.ORGLOB,244,5,DFN,ORDBEG,ORDEND,,ORMAX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV04 8124 printed Apr 09, 2024@21:24:31 Page 2
ORDV04 ; SLC/DAN - OE/RR Components ;10/02/14 08:08
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,148,160,208,195,241,215,274,256,243,306,361,395**;Dec 17,1997;Build 11
+2 ;
+3 ; ^TMP("GMPLHS",$J) DBIA 1183
+4 ; ^UTILITY & ^TMP("GMRVD") DBIA 10061
+5 ;
ORC(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Current Orders
+1 NEW ORCNT,ORJ,ORSITE,SITE,ORX0,ORLIST,GO
+2 if '$LENGTH(OREXT)
QUIT
+3 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+4 if '$LENGTH($TEXT(@GO))
QUIT
+5 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+6 KILL ^TMP("ORR",$JOB),^TMP("ORDATA",$JOB)
+7 DO @GO
+8 IF '$DATA(^TMP("ORR",$JOB))
QUIT
+9 SET ORCNT=0
SET ORJ=0
+10 FOR
SET ORJ=$ORDER(^TMP("ORR",$JOB,ORLIST,ORJ))
if '+ORJ!(ORCNT'<ORMAX)
QUIT
SET ORX0=^(ORJ)
Begin DoDot:1
+11 SET ORCNT=ORCNT+1
SET SITE=$SELECT($LENGTH($GET(^TMP("ORR",$JOB,ORLIST,ORJ,"facility"))):^("facility"),1:ORSITE)
+12 ;Station ID
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",1)="1^"_SITE
+13 ;order text
DO SPMRG^ORDVU("^TMP(""ORR"","_$JOB_","""_ORLIST_""","_ORJ_",""TX"")","^TMP(""ORDATA"","_$JOB_","""_ORLIST_""","_ORJ_",""WP"",2)",2)
+14 ; status
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",3)="3^"_$PIECE(ORX0,"^",6)
+15 ;start date
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",4)="4^"_$$DATE^ORDVU($PIECE(ORX0,"^",4))
+16 ;stop date
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",5)="5^"_$$DATE^ORDVU($PIECE(ORX0,"^",5))
+17 ;Order Number
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",7)="7^"_$PIECE(^TMP("ORR",$JOB,ORLIST,ORJ),U)
+18 ;flag for details
IF $ORDER(^TMP("ORR",$JOB,ORLIST,ORJ,"TX",1))
SET ^TMP("ORDATA",$JOB,ORLIST,ORJ,"WP",6)="6^[+]"
End DoDot:1
+19 KILL ^TMP("ORR",$JOB)
+20 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+21 QUIT
ORCVA ; Current Orders
+1 NEW ORVP
+2 SET ORVP=DFN_";DPT("
+3 IF '$DATA(^OR(100,"AC",ORVP))
QUIT
+4 ; 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) ; API - 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) ; API - 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) ; API - 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 ;Ext call: GMPLHS
+2 ; input:
+3 ; STATUS = "A" => active
+4 ; STATUS = "I" => inactive
+5 ; STATUS = "ALL" => all
+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,ORLOC,I,ORSITE
+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 NEW ORXREC0,SITE,ICD,SCTC,VHATC,PROVNARR,ORMORE,K,ORCSYS,ORICDLBL
+19 SET ORXREC0=$GET(^TMP("GMPLHS",$JOB,ORPROBNO,0))
SET ORMORE=0
+20 SET SITE=$SELECT($LENGTH($GET(^TMP("GMPLHS",$JOB,ORPROBNO,"facility"))):^("facility"),1:ORSITE)
+21 SET ICD=$PIECE(ORXREC0,U,17)
SET SCTC=$PIECE(ORXREC0,U,15)
SET VHATC=$PIECE(ORXREC0,U,19)
+22 SET ORCSYS=$PIECE(ORXREC0,U,22)
SET ORICDLBL=$SELECT(ORCSYS="10D":"ICD-10-CM",1:"ICD-9-CM")
+23 SET PROVNARR=$PIECE($GET(^TMP("GMPLHS",$JOB,ORPROBNO,"N"))," (")
+24 SET PROVNARR=PROVNARR_$SELECT($LENGTH($GET(ICD))&('$LENGTH($GET(SCTC))&'$LENGTH(...
... $GET(VHATC))):" ("_$GET(ORICDLBL)_" "_$GET(ICD)_")",$LENGTH($GET(SCTC))&($LENGTH($GET(ICD))):" (SCT "_$GET(SCTC)_")"_" ("_$GET(ORICDLBL)_" "_$GET(ICD)_")",$LENGTH($GET(VHATC)):" (VHAT "_$GET(VHATC)_")",1:"")
+25 ;Station ID
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",1)="1^"_SITE
+26 ;status
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",2)="2^"_$PIECE(ORXREC0,U,5)
+27 ;provider narrative
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",3)="3^"_PROVNARR
+28 ;onset date
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",4)="4^"_$$DATE^ORDVU($PIECE(ORXREC0,U,6))
+29 ;last modified date
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",5)="5^"_$$DATE^ORDVU($PIECE(ORXREC0,U,2))
+30 ;provider
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",6)="6^"_$PIECE(ORXREC0,U,7)
+31 SET ORLOC=0
SET K=0
+32 FOR
SET ORLOC=$ORDER(^TMP("GMPLHS",$JOB,ORPROBNO,"C",ORLOC))
if 'ORLOC
QUIT
Begin DoDot:2
+33 NEW X
SET X=0
+34 FOR
SET X=$ORDER(^TMP("GMPLHS",$JOB,ORPROBNO,"C",ORLOC,X))
if 'X
QUIT
Begin DoDot:3
+35 SET K=K+1
SET ORMORE=1
+36 ;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
+37 ;exposures
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",8)="8^"_$PIECE(ORXREC0,U,14)
+38 ;flag for details
IF ORMORE
SET ^TMP("ORDATA",$JOB,ORPROBNO,"WP",9)="9^[+]"
End DoDot:1
+39 KILL ^TMP("GMPLHS",$JOB)
+40 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+41 QUIT
SR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Surgery Report
+1 NEW ORCNT
+2 SET ORCNT=0
+3 KILL ^TMP("ORDATA",$JOB)
+4 DO ENSR^ORDV04A
+5 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+6 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) ; progress notes
+1 ;Ext calls: 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 ; 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 ;Ext 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 ; Discharge Summary
+1 DO CONTEXT^TIUSRVLO(.ORGLOB,244,5,DFN,ORDBEG,ORDEND,,ORMAX)
+2 QUIT
