ORDV07 ;SLC/DAN/KER - OE/RR Report extracts ;Dec 29, 2021@11:43
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,159,558**;Dec 17,1997;Build 15
;
; External References
; DBIA 10112 $$SITE^VASITE
; DBIA 10061 4^VADPT
; DBIA 10061 OAD^VADPT
; DBIA 10145 ALL^IBCNS1
; DBIA 767 ^DGSL(38.1,
; DBIA 1407 ^FHWHEA
; DBIA 3818 ICDS^GMTSDGP
; DBIA 3818 ICDP^GMTSDGP
; DBIA 418 ^DGPT("B"
; DBIA 794 ^DIC(36,
; DBIA 951 ^IBE(355.1,
;
;Dietetics components
DIETA(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All diet
N ORTYPE S ORTYPE="DI" D DIET Q
DIETN(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Nutritional Status
N ORTYPE S ORTYPE="NS" D DIET Q
DIETS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Supplemental Feedings
N ORTYPE S ORTYPE="SF" D DIET Q
DIETT(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Tube feedings
N ORTYPE S ORTYPE="TF" D DIET Q
;
DIET ;Main diet entry point
;External calls to FHWHEA and SITE^VASITE
;Data returned in ^TMP("ORDATA",$J) by type:
; ALL=Facility^Start Date^End Date^Diet^Comment^Service(tray,dining room, etc)
; Nutritional Status=Facility^Status Date^Status
; Supplemental Feeding=Facility^Date Ordered^Date Canceled^10am feeding^2pm feeding^8pm feeding
; Tubefeeding=Facility^Date Ordered^Date Canceled^Product^Strength^Quantity^Daily CCs^Daily KCal^Comment
;
N GMTS1,GMTS2,GMTSNDM,ORSITE,SITE,ORDT
S GMTS1=OROMEGA-.24,GMTS2=ORALPHA,GMTSNDM=ORMAX
K ^TMP("ORDATA",$J)
D ^FHWHEA ;get all diet information. Returned in ^UTILITY($J)
Q:'$D(^UTILITY($J,ORTYPE)) ;no data to report for type selected
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
S ORDT=0
F S ORDT=$O(^UTILITY($J,ORTYPE,ORDT)) Q:ORDT="" D
. S SITE=$S($L($G(^UTILITY($J,ORTYPE,ORDT,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,ORDT,"WP",1)="1^"_SITE ;Station ID
. S ^TMP("ORDATA",$J,ORDT,"WP",2)="2^"_$$DATE^ORDVU($P(^UTILITY($J,ORTYPE,ORDT,0),"^")) ;date
. S ^TMP("ORDATA",$J,ORDT,"WP",3)="3^"_$S(ORTYPE="NS":$P(^UTILITY($J,ORTYPE,ORDT,0),"^",2),1:$$DATE^ORDVU($P(^UTILITY($J,ORTYPE,ORDT,0),"^",2)))
. Q:ORTYPE="NS" ;no more data required for NS
. S ^TMP("ORDATA",$J,ORDT,"WP",4)="4^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",3)
. S ^TMP("ORDATA",$J,ORDT,"WP",5)="5^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",4)
. S ^TMP("ORDATA",$J,ORDT,"WP",6)="6^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",5)
. Q:ORTYPE'="TF"
. ;Get remaining data for tube feedings
. S ^TMP("ORDATA",$J,ORDT,"WP",7)="7^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",6)
. S ^TMP("ORDATA",$J,ORDT,"WP",8)="8^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",7)
. S ^TMP("ORDATA",$J,ORDT,"WP",9)="9^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",8)
K ^UTILITY($J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
;
DEM(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; ADT Demographics
; External calls to VASITE, VADPT, and ^DGSL(38.1
N VADM,VAPA,VAOA,ORSITE,SITE,I,ORDAT,ORETHN,ORRACE S (ORETHN,ORRACE)=""
K ^TMP("ORDATA",$J)
D 4^VADPT,OAD^VADPT
; Quit if error in data gathering, otherwise get
; demographic/address information as well as next
; of kin addres
Q:VAERR
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
S SITE=ORSITE
; 1 Site
S ^TMP("ORDATA",$J,1,"WP",1)="1^"_SITE
; 2 Patient Name
S ^TMP("ORDATA",$J,1,"WP",2)="2^"_VADM(1)
; 3 SSN
S ^TMP("ORDATA",$J,1,"WP",3)="3^"_$P(VADM(2),"^")
; 4 Birth Sex
S ^TMP("ORDATA",$J,1,"WP",4)="4^"_$P(VADM(5),"^",2)
; 5 Self identified gender identity (SIGI)
S ^TMP("ORDATA",$J,1,"WP",5)="5^"_$$UP^XLFSTR($P($$GET1^DIQ(2,DFN,.024,"E"),"/"))
; 6 Date of Birth
S ^TMP("ORDATA",$J,1,"WP",6)="6^"_$$DATE^ORDVU($P(VADM(3),"^"))
; 7 Religion
S ^TMP("ORDATA",$J,1,"WP",7)="7^"_$P(VADM(9),"^",2)
; 8 Marital Status
S ^TMP("ORDATA",$J,1,"WP",8)="8^"_$P(VADM(10),"^",2)
; 9 Phone Number
S ^TMP("ORDATA",$J,1,"WP",9)="9^"_VAPA(8)
; 10 Street Address (1-3), City, State, and ZIP
S ^TMP("ORDATA",$J,1,"WP",10,1)="10^"_VAPA(1) I $P(^(1),"^",2)="" K ^(1)
S ^TMP("ORDATA",$J,1,"WP",10,2)="10^"_VAPA(2) I $P(^(2),"^",2)="" K ^(2)
S ^TMP("ORDATA",$J,1,"WP",10,3)="10^"_VAPA(3) I $P(^(3),"^",2)="" K ^(3)
S ^TMP("ORDATA",$J,1,"WP",10,4)="10^"_VAPA(4)_$S($G(VAPA(4))'="":", ",1:"")_$P(VAPA(5),"^",2)_" "_VAPA(6)
; 12 Ethnicity
S I=0 F S I=$O(VADM(11,I)) Q:+I=0 D
. S ORDAT=$P(VADM(11,I),"^",2) Q:'$L(ORDAT)
. S ORETHN=$G(ORETHN)_", "_ORDAT
. S ^TMP("ORDATA",$J,1,"WP",12,I)="12^"_ORDAT
; 11 Race
S:$L(ORETHN) ^TMP("ORDATA",$J,1,"WP",11,1)="11^"
S I=0 F S I=$O(VADM(12,I)) Q:+I=0 D
. S ORDAT=$P($G(VADM(12,I)),"^",2) Q:'$L(ORDAT)
. S ORRACE=$G(ORRACE)_", "_ORDAT
. S ^TMP("ORDATA",$J,1,"WP",11,I)="11^"_ORDAT
S ORRACE=$P(ORRACE,", ",2,$L(ORRACE,", "))
I '$L($P($G(^TMP("ORDATA",$J,1,"WP",12,1)),"^",2)) D
. I '$L($P($G(^TMP("ORDATA",$J,1,"WP",11,1)),"^",2)) D
. . S ^TMP("ORDATA",$J,1,"WP",12,1)="12^"
. . S ^TMP("ORDATA",$J,1,"WP",11,1)="11^"_$P($G(VADM(8)),"^",2)
S ORETHN=$P(ORETHN,", ",2,$L(ORETHN,", "))
; 13 Next of Kin
S ^TMP("ORDATA",$J,1,"WP",13)="13^"_VAOA(9)
; 13 Next of Kin Relationship
S ^TMP("ORDATA",$J,1,"WP",14)="14^"_VAOA(10)
; 14 NOK Street Address (1-3), City, State, and ZIP
S ^TMP("ORDATA",$J,1,"WP",15,1)="15^"_VAOA(1) I $P(^(1),"^",2)="" K ^(1)
S ^TMP("ORDATA",$J,1,"WP",15,2)="15^"_VAOA(2) I $P(^(2),"^",2)="" K ^(2)
S ^TMP("ORDATA",$J,1,"WP",15,3)="15^"_VAOA(3) I $P(^(3),"^",2)=""
S ^TMP("ORDATA",$J,1,"WP",15,4)="15^"_VAOA(4)_$S($G(VAOA(4))'="":", ",1:"")_$P(VAOA(5),"^",2)_" "_VAOA(6)
; 15 Security Log
S ^TMP("ORDATA",$J,1,"WP",16)="16^"_$S($P($G(^DGSL(38.1,DFN,0)),"^",2):"YES",1:"NO")
S ROOT=$NA(^TMP("ORDATA",$J))
Q
ICDSUR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return ICD Surgery Information
;External calls to VASITE, GMTSDGP
N ORSITE,SITE,T1,T2,I,J,GMS,PTF,ORDATE
K ^TMP("ORDATA",$J)
S T1=ORDEND,T2=ORDBEG,ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
F PTF=0:0 S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF="" D ICDS^GMTSDGP
S (I,ORDATE)=0
F S ORDATE=$O(GMS(ORDATE)) Q:ORDATE=""!(I'<ORMAX) S J=0 D
. F S J=$O(GMS(ORDATE,J)) Q:'J!(I'<ORMAX) S I=I+1 D ;Check for multiple procedures on same date
.. S SITE=$S($L($G(GMS(ORDATE,J,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,1)="1^"_SITE
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,2)="2^"_$$DATEMMM^ORDVU($P(GMS(ORDATE)," ",3)) ;Date of procedure
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,3)="3^"_$P($G(GMS(ORDATE,J)),"^") ;Surgery and code
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,4)="4^"_$P(GMS(ORDATE,J),"^",2) ;ICD code
S ROOT=$NA(^TMP("ORDATA",$J))
Q
PRC(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return Procedure Information
;External calls to VASITE, GMTSDGP
N ORSITE,SITE,T1,T2,I,J,GMP,PTF,ORDATE
K ^TMP("ORDATA",$J)
S T1=ORDEND,T2=ORDBEG,PTF=0,ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
F S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF="" D ICDP^GMTSDGP
S (I,ORDATE)=0
F S ORDATE=$O(GMP(ORDATE)) Q:ORDATE=""!(I'<ORMAX) S J=0 D
. F S J=$O(GMP(ORDATE,J)) Q:'J!(I'<ORMAX) S I=I+1 D ;Check for multiple procedures on same date
.. S SITE=$S($L($G(GMP(ORDATE,J,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,1)="1^"_SITE
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,2)="2^"_$$DATEMMM^ORDVU($P(GMP(ORDATE)," ",2)) ;Date of procedure
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,3)="3^"_$P($G(GMP(ORDATE,J)),"^") ;Procedure and code
.. S ^TMP("ORDATA",$J,"WP",ORDATE,J,4)="4^"_$P(GMP(ORDATE,J),"^",2) ;ICD code
S ROOT=$NA(^TMP("ORDATA",$J))
Q
INS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return Insurance Information
;External calls to VASITE and IBCNS1 and ^DIC(36, and ^IBE(355.1
N ORSITE,SITE,ORARRAY,I
K ^TMP("ORDATA",$J)
D ALL^IBCNS1(DFN,"ORARRAY")
Q:'$D(ORARRAY) ;quit if no insurance data returned
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3),I=0
F S I=$O(ORARRAY(I)) Q:'I D
. S SITE=$S($L($G(ORARRAY(I,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,"WP",I,1)="1^"_SITE
. S ^TMP("ORDATA",$J,"WP",I,2)="2^"_$P($G(^DIC(36,+$P(ORARRAY(I,0),"^"),0)),"^") ;Insurance company
. S ^TMP("ORDATA",$J,"WP",I,3)="3^"_$P($G(^IBE(355.1,+$P(ORARRAY(I,355.3),"^",9),0)),"^") ;Policy type
. S ^TMP("ORDATA",$J,"WP",I,4)="4^"_$P(ORARRAY(I,355.3),"^",4) ;Group number
. S ^TMP("ORDATA",$J,"WP",I,5)="5^"_$S($P(ORARRAY(I,0),"^",6)="s":"SPOUSE",$P(ORARRAY(I,0),"^",6)="v":"SELF",1:"OTHER") ;Policy holder
. S ^TMP("ORDATA",$J,"WP",I,6)="6^"_$$DATE^ORDVU($P(ORARRAY(I,0),"^",8)) ;Effective date of policy
. S ^TMP("ORDATA",$J,"WP",I,7)="7^"_$$DATE^ORDVU($P(ORARRAY(I,0),"^",4)) ;Expiration date of policy
S ROOT=$NA(^TMP("ORDATA",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV07 8834 printed Dec 13, 2024@02:30:20 Page 2
ORDV07 ;SLC/DAN/KER - OE/RR Report extracts ;Dec 29, 2021@11:43
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,120,159,558**;Dec 17,1997;Build 15
+2 ;
+3 ; External References
+4 ; DBIA 10112 $$SITE^VASITE
+5 ; DBIA 10061 4^VADPT
+6 ; DBIA 10061 OAD^VADPT
+7 ; DBIA 10145 ALL^IBCNS1
+8 ; DBIA 767 ^DGSL(38.1,
+9 ; DBIA 1407 ^FHWHEA
+10 ; DBIA 3818 ICDS^GMTSDGP
+11 ; DBIA 3818 ICDP^GMTSDGP
+12 ; DBIA 418 ^DGPT("B"
+13 ; DBIA 794 ^DIC(36,
+14 ; DBIA 951 ^IBE(355.1,
+15 ;
+16 ;Dietetics components
DIETA(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All diet
+1 NEW ORTYPE
SET ORTYPE="DI"
DO DIET
QUIT
DIETN(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Nutritional Status
+1 NEW ORTYPE
SET ORTYPE="NS"
DO DIET
QUIT
DIETS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Supplemental Feedings
+1 NEW ORTYPE
SET ORTYPE="SF"
DO DIET
QUIT
DIETT(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Tube feedings
+1 NEW ORTYPE
SET ORTYPE="TF"
DO DIET
QUIT
+2 ;
DIET ;Main diet entry point
+1 ;External calls to FHWHEA and SITE^VASITE
+2 ;Data returned in ^TMP("ORDATA",$J) by type:
+3 ; ALL=Facility^Start Date^End Date^Diet^Comment^Service(tray,dining room, etc)
+4 ; Nutritional Status=Facility^Status Date^Status
+5 ; Supplemental Feeding=Facility^Date Ordered^Date Canceled^10am feeding^2pm feeding^8pm feeding
+6 ; Tubefeeding=Facility^Date Ordered^Date Canceled^Product^Strength^Quantity^Daily CCs^Daily KCal^Comment
+7 ;
+8 NEW GMTS1,GMTS2,GMTSNDM,ORSITE,SITE,ORDT
+9 SET GMTS1=OROMEGA-.24
SET GMTS2=ORALPHA
SET GMTSNDM=ORMAX
+10 KILL ^TMP("ORDATA",$JOB)
+11 ;get all diet information. Returned in ^UTILITY($J)
DO ^FHWHEA
+12 ;no data to report for type selected
if '$DATA(^UTILITY($JOB,ORTYPE))
QUIT
+13 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+14 SET ORDT=0
+15 FOR
SET ORDT=$ORDER(^UTILITY($JOB,ORTYPE,ORDT))
if ORDT=""
QUIT
Begin DoDot:1
+16 SET SITE=$SELECT($LENGTH($GET(^UTILITY($JOB,ORTYPE,ORDT,"facility"))):^("facility"),1:ORSITE)
+17 ;Station ID
SET ^TMP("ORDATA",$JOB,ORDT,"WP",1)="1^"_SITE
+18 ;date
SET ^TMP("ORDATA",$JOB,ORDT,"WP",2)="2^"_$$DATE^ORDVU($PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^"))
+19 SET ^TMP("ORDATA",$JOB,ORDT,"WP",3)="3^"_$SELECT(ORTYPE="NS":$PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",2),1:$$DATE^ORDVU($PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",2)))
+20 ;no more data required for NS
if ORTYPE="NS"
QUIT
+21 SET ^TMP("ORDATA",$JOB,ORDT,"WP",4)="4^"_$PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",3)
+22 SET ^TMP("ORDATA",$JOB,ORDT,"WP",5)="5^"_$PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",4)
+23 SET ^TMP("ORDATA",$JOB,ORDT,"WP",6)="6^"_$PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",5)
+24 if ORTYPE'="TF"
QUIT
+25 ;Get remaining data for tube feedings
+26 SET ^TMP("ORDATA",$JOB,ORDT,"WP",7)="7^"_$PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",6)
+27 SET ^TMP("ORDATA",$JOB,ORDT,"WP",8)="8^"_$PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",7)
+28 SET ^TMP("ORDATA",$JOB,ORDT,"WP",9)="9^"_$PIECE(^UTILITY($JOB,ORTYPE,ORDT,0),"^",8)
End DoDot:1
+29 KILL ^UTILITY($JOB)
+30 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+31 QUIT
+32 ;
DEM(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; ADT Demographics
+1 ; External calls to VASITE, VADPT, and ^DGSL(38.1
+2 NEW VADM,VAPA,VAOA,ORSITE,SITE,I,ORDAT,ORETHN,ORRACE
SET (ORETHN,ORRACE)=""
+3 KILL ^TMP("ORDATA",$JOB)
+4 DO 4^VADPT
DO OAD^VADPT
+5 ; Quit if error in data gathering, otherwise get
+6 ; demographic/address information as well as next
+7 ; of kin addres
+8 if VAERR
QUIT
+9 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+10 SET SITE=ORSITE
+11 ; 1 Site
+12 SET ^TMP("ORDATA",$JOB,1,"WP",1)="1^"_SITE
+13 ; 2 Patient Name
+14 SET ^TMP("ORDATA",$JOB,1,"WP",2)="2^"_VADM(1)
+15 ; 3 SSN
+16 SET ^TMP("ORDATA",$JOB,1,"WP",3)="3^"_$PIECE(VADM(2),"^")
+17 ; 4 Birth Sex
+18 SET ^TMP("ORDATA",$JOB,1,"WP",4)="4^"_$PIECE(VADM(5),"^",2)
+19 ; 5 Self identified gender identity (SIGI)
+20 SET ^TMP("ORDATA",$JOB,1,"WP",5)="5^"_$$UP^XLFSTR($PIECE($$GET1^DIQ(2,DFN,.024,"E"),"/"))
+21 ; 6 Date of Birth
+22 SET ^TMP("ORDATA",$JOB,1,"WP",6)="6^"_$$DATE^ORDVU($PIECE(VADM(3),"^"))
+23 ; 7 Religion
+24 SET ^TMP("ORDATA",$JOB,1,"WP",7)="7^"_$PIECE(VADM(9),"^",2)
+25 ; 8 Marital Status
+26 SET ^TMP("ORDATA",$JOB,1,"WP",8)="8^"_$PIECE(VADM(10),"^",2)
+27 ; 9 Phone Number
+28 SET ^TMP("ORDATA",$JOB,1,"WP",9)="9^"_VAPA(8)
+29 ; 10 Street Address (1-3), City, State, and ZIP
+30 SET ^TMP("ORDATA",$JOB,1,"WP",10,1)="10^"_VAPA(1)
IF $PIECE(^(1),"^",2)=""
KILL ^(1)
+31 SET ^TMP("ORDATA",$JOB,1,"WP",10,2)="10^"_VAPA(2)
IF $PIECE(^(2),"^",2)=""
KILL ^(2)
+32 SET ^TMP("ORDATA",$JOB,1,"WP",10,3)="10^"_VAPA(3)
IF $PIECE(^(3),"^",2)=""
KILL ^(3)
+33 SET ^TMP("ORDATA",$JOB,1,"WP",10,4)="10^"_VAPA(4)_$SELECT($GET(VAPA(4))'="":", ",1:"")_$PIECE(VAPA(5),"^",2)_" "_VAPA(6)
+34 ; 12 Ethnicity
+35 SET I=0
FOR
SET I=$ORDER(VADM(11,I))
if +I=0
QUIT
Begin DoDot:1
+36 SET ORDAT=$PIECE(VADM(11,I),"^",2)
if '$LENGTH(ORDAT)
QUIT
+37 SET ORETHN=$GET(ORETHN)_", "_ORDAT
+38 SET ^TMP("ORDATA",$JOB,1,"WP",12,I)="12^"_ORDAT
End DoDot:1
+39 ; 11 Race
+40 if $LENGTH(ORETHN)
SET ^TMP("ORDATA",$JOB,1,"WP",11,1)="11^"
+41 SET I=0
FOR
SET I=$ORDER(VADM(12,I))
if +I=0
QUIT
Begin DoDot:1
+42 SET ORDAT=$PIECE($GET(VADM(12,I)),"^",2)
if '$LENGTH(ORDAT)
QUIT
+43 SET ORRACE=$GET(ORRACE)_", "_ORDAT
+44 SET ^TMP("ORDATA",$JOB,1,"WP",11,I)="11^"_ORDAT
End DoDot:1
+45 SET ORRACE=$PIECE(ORRACE,", ",2,$LENGTH(ORRACE,", "))
+46 IF '$LENGTH($PIECE($GET(^TMP("ORDATA",$JOB,1,"WP",12,1)),"^",2))
Begin DoDot:1
+47 IF '$LENGTH($PIECE($GET(^TMP("ORDATA",$JOB,1,"WP",11,1)),"^",2))
Begin DoDot:2
+48 SET ^TMP("ORDATA",$JOB,1,"WP",12,1)="12^"
+49 SET ^TMP("ORDATA",$JOB,1,"WP",11,1)="11^"_$PIECE($GET(VADM(8)),"^",2)
End DoDot:2
End DoDot:1
+50 SET ORETHN=$PIECE(ORETHN,", ",2,$LENGTH(ORETHN,", "))
+51 ; 13 Next of Kin
+52 SET ^TMP("ORDATA",$JOB,1,"WP",13)="13^"_VAOA(9)
+53 ; 13 Next of Kin Relationship
+54 SET ^TMP("ORDATA",$JOB,1,"WP",14)="14^"_VAOA(10)
+55 ; 14 NOK Street Address (1-3), City, State, and ZIP
+56 SET ^TMP("ORDATA",$JOB,1,"WP",15,1)="15^"_VAOA(1)
IF $PIECE(^(1),"^",2)=""
KILL ^(1)
+57 SET ^TMP("ORDATA",$JOB,1,"WP",15,2)="15^"_VAOA(2)
IF $PIECE(^(2),"^",2)=""
KILL ^(2)
+58 SET ^TMP("ORDATA",$JOB,1,"WP",15,3)="15^"_VAOA(3)
IF $PIECE(^(3),"^",2)=""
+59 SET ^TMP("ORDATA",$JOB,1,"WP",15,4)="15^"_VAOA(4)_$SELECT($GET(VAOA(4))'="":", ",1:"")_$PIECE(VAOA(5),"^",2)_" "_VAOA(6)
+60 ; 15 Security Log
+61 SET ^TMP("ORDATA",$JOB,1,"WP",16)="16^"_$SELECT($PIECE($GET(^DGSL(38.1,DFN,0)),"^",2):"YES",1:"NO")
+62 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+63 QUIT
ICDSUR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return ICD Surgery Information
+1 ;External calls to VASITE, GMTSDGP
+2 NEW ORSITE,SITE,T1,T2,I,J,GMS,PTF,ORDATE
+3 KILL ^TMP("ORDATA",$JOB)
+4 SET T1=ORDEND
SET T2=ORDBEG
SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+5 FOR PTF=0:0
SET PTF=$ORDER(^DGPT("B",DFN,PTF))
if PTF=""
QUIT
DO ICDS^GMTSDGP
+6 SET (I,ORDATE)=0
+7 FOR
SET ORDATE=$ORDER(GMS(ORDATE))
if ORDATE=""!(I'<ORMAX)
QUIT
SET J=0
Begin DoDot:1
+8 ;Check for multiple procedures on same date
FOR
SET J=$ORDER(GMS(ORDATE,J))
if 'J!(I'<ORMAX)
QUIT
SET I=I+1
Begin DoDot:2
+9 SET SITE=$SELECT($LENGTH($GET(GMS(ORDATE,J,"facility"))):^("facility"),1:ORSITE)
+10 SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,1)="1^"_SITE
+11 ;Date of procedure
SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,2)="2^"_$$DATEMMM^ORDVU($PIECE(GMS(ORDATE)," ",3))
+12 ;Surgery and code
SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,3)="3^"_$PIECE($GET(GMS(ORDATE,J)),"^")
+13 ;ICD code
SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,4)="4^"_$PIECE(GMS(ORDATE,J),"^",2)
End DoDot:2
End DoDot:1
+14 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+15 QUIT
PRC(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return Procedure Information
+1 ;External calls to VASITE, GMTSDGP
+2 NEW ORSITE,SITE,T1,T2,I,J,GMP,PTF,ORDATE
+3 KILL ^TMP("ORDATA",$JOB)
+4 SET T1=ORDEND
SET T2=ORDBEG
SET PTF=0
SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+5 FOR
SET PTF=$ORDER(^DGPT("B",DFN,PTF))
if PTF=""
QUIT
DO ICDP^GMTSDGP
+6 SET (I,ORDATE)=0
+7 FOR
SET ORDATE=$ORDER(GMP(ORDATE))
if ORDATE=""!(I'<ORMAX)
QUIT
SET J=0
Begin DoDot:1
+8 ;Check for multiple procedures on same date
FOR
SET J=$ORDER(GMP(ORDATE,J))
if 'J!(I'<ORMAX)
QUIT
SET I=I+1
Begin DoDot:2
+9 SET SITE=$SELECT($LENGTH($GET(GMP(ORDATE,J,"facility"))):^("facility"),1:ORSITE)
+10 SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,1)="1^"_SITE
+11 ;Date of procedure
SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,2)="2^"_$$DATEMMM^ORDVU($PIECE(GMP(ORDATE)," ",2))
+12 ;Procedure and code
SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,3)="3^"_$PIECE($GET(GMP(ORDATE,J)),"^")
+13 ;ICD code
SET ^TMP("ORDATA",$JOB,"WP",ORDATE,J,4)="4^"_$PIECE(GMP(ORDATE,J),"^",2)
End DoDot:2
End DoDot:1
+14 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+15 QUIT
INS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return Insurance Information
+1 ;External calls to VASITE and IBCNS1 and ^DIC(36, and ^IBE(355.1
+2 NEW ORSITE,SITE,ORARRAY,I
+3 KILL ^TMP("ORDATA",$JOB)
+4 DO ALL^IBCNS1(DFN,"ORARRAY")
+5 ;quit if no insurance data returned
if '$DATA(ORARRAY)
QUIT
+6 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
SET I=0
+7 FOR
SET I=$ORDER(ORARRAY(I))
if 'I
QUIT
Begin DoDot:1
+8 SET SITE=$SELECT($LENGTH($GET(ORARRAY(I,"facility"))):^("facility"),1:ORSITE)
+9 SET ^TMP("ORDATA",$JOB,"WP",I,1)="1^"_SITE
+10 ;Insurance company
SET ^TMP("ORDATA",$JOB,"WP",I,2)="2^"_$PIECE($GET(^DIC(36,+$PIECE(ORARRAY(I,0),"^"),0)),"^")
+11 ;Policy type
SET ^TMP("ORDATA",$JOB,"WP",I,3)="3^"_$PIECE($GET(^IBE(355.1,+$PIECE(ORARRAY(I,355.3),"^",9),0)),"^")
+12 ;Group number
SET ^TMP("ORDATA",$JOB,"WP",I,4)="4^"_$PIECE(ORARRAY(I,355.3),"^",4)
+13 ;Policy holder
SET ^TMP("ORDATA",$JOB,"WP",I,5)="5^"_$SELECT($PIECE(ORARRAY(I,0),"^",6)="s":"SPOUSE",$PIECE(ORARRAY(I,0),"^",6)="v":"SELF",1:"OTHER")
+14 ;Effective date of policy
SET ^TMP("ORDATA",$JOB,"WP",I,6)="6^"_$$DATE^ORDVU($PIECE(ORARRAY(I,0),"^",8))
+15 ;Expiration date of policy
SET ^TMP("ORDATA",$JOB,"WP",I,7)="7^"_$$DATE^ORDVU($PIECE(ORARRAY(I,0),"^",4))
End DoDot:1
+16 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+17 QUIT
