ORDV04.m

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 ---ORDV04   8124     printed  Mar 13, 2025@21:35:06                                                                                                                                                                                                      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