- 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
