Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORDV07

ORDV07.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; External References
  1.  ;   DBIA  10112  $$SITE^VASITE
  1.  ;   DBIA  10061  4^VADPT
  1.  ;   DBIA  10061  OAD^VADPT
  1.  ;   DBIA  10145  ALL^IBCNS1
  1.  ;   DBIA    767  ^DGSL(38.1,
  1.  ;   DBIA   1407  ^FHWHEA
  1.  ;   DBIA   3818  ICDS^GMTSDGP
  1.  ;   DBIA   3818  ICDP^GMTSDGP
  1.  ;   DBIA    418  ^DGPT("B"
  1.  ;   DBIA    794  ^DIC(36,
  1.  ;   DBIA    951  ^IBE(355.1,
  1.  ;
  1.  ;Dietetics components
  1. DIETA(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;All diet
  1.  N ORTYPE S ORTYPE="DI" D DIET Q
  1. DIETN(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Nutritional Status
  1.  N ORTYPE S ORTYPE="NS" D DIET Q
  1. DIETS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Supplemental Feedings
  1.  N ORTYPE S ORTYPE="SF" D DIET Q
  1. DIETT(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Tube feedings
  1.  N ORTYPE S ORTYPE="TF" D DIET Q
  1.  ;
  1. DIET ;Main diet entry point
  1.  ;External calls to FHWHEA and SITE^VASITE
  1.  ;Data returned in ^TMP("ORDATA",$J) by type:
  1.  ;  ALL=Facility^Start Date^End Date^Diet^Comment^Service(tray,dining room, etc)
  1.  ;  Nutritional Status=Facility^Status Date^Status
  1.  ;  Supplemental Feeding=Facility^Date Ordered^Date Canceled^10am feeding^2pm feeding^8pm feeding
  1.  ;  Tubefeeding=Facility^Date Ordered^Date Canceled^Product^Strength^Quantity^Daily CCs^Daily KCal^Comment
  1.  ;
  1.  N GMTS1,GMTS2,GMTSNDM,ORSITE,SITE,ORDT
  1.  S GMTS1=OROMEGA-.24,GMTS2=ORALPHA,GMTSNDM=ORMAX
  1.  K ^TMP("ORDATA",$J)
  1.  D ^FHWHEA ;get all diet information.  Returned in ^UTILITY($J)
  1.  Q:'$D(^UTILITY($J,ORTYPE))  ;no data to report for type selected
  1.  S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
  1.  S ORDT=0
  1.  F  S ORDT=$O(^UTILITY($J,ORTYPE,ORDT)) Q:ORDT=""  D
  1.  . S SITE=$S($L($G(^UTILITY($J,ORTYPE,ORDT,"facility"))):^("facility"),1:ORSITE)
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",1)="1^"_SITE ;Station ID
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",2)="2^"_$$DATE^ORDVU($P(^UTILITY($J,ORTYPE,ORDT,0),"^")) ;date
  1.  . 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)))
  1.  . Q:ORTYPE="NS"  ;no more data required for NS
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",4)="4^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",3)
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",5)="5^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",4)
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",6)="6^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",5)
  1.  . Q:ORTYPE'="TF"
  1.  . ;Get remaining data for tube feedings
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",7)="7^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",6)
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",8)="8^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",7)
  1.  . S ^TMP("ORDATA",$J,ORDT,"WP",9)="9^"_$P(^UTILITY($J,ORTYPE,ORDT,0),"^",8)
  1.  K ^UTILITY($J)
  1.  S ROOT=$NA(^TMP("ORDATA",$J))
  1.  Q
  1.  ;
  1. DEM(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; ADT Demographics
  1.  ; External calls to VASITE, VADPT, and ^DGSL(38.1
  1.  N VADM,VAPA,VAOA,ORSITE,SITE,I,ORDAT,ORETHN,ORRACE S (ORETHN,ORRACE)=""
  1.  K ^TMP("ORDATA",$J)
  1.  D 4^VADPT,OAD^VADPT
  1.  ; Quit if error in data gathering, otherwise get
  1.  ; demographic/address information as well as next
  1.  ; of kin addres
  1.  Q:VAERR
  1.  S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
  1.  S SITE=ORSITE
  1.  ;  1  Site
  1.  S ^TMP("ORDATA",$J,1,"WP",1)="1^"_SITE
  1.  ;  2  Patient Name
  1.  S ^TMP("ORDATA",$J,1,"WP",2)="2^"_VADM(1)
  1.  ;  3  SSN
  1.  S ^TMP("ORDATA",$J,1,"WP",3)="3^"_$P(VADM(2),"^")
  1.  ;  4  Birth Sex
  1.  S ^TMP("ORDATA",$J,1,"WP",4)="4^"_$P(VADM(5),"^",2)
  1.  ;  5  Self identified gender identity (SIGI)
  1.  S ^TMP("ORDATA",$J,1,"WP",5)="5^"_$$UP^XLFSTR($P($$GET1^DIQ(2,DFN,.024,"E"),"/"))
  1.  ;  6  Date of Birth
  1.  S ^TMP("ORDATA",$J,1,"WP",6)="6^"_$$DATE^ORDVU($P(VADM(3),"^"))
  1.  ;  7  Religion
  1.  S ^TMP("ORDATA",$J,1,"WP",7)="7^"_$P(VADM(9),"^",2)
  1.  ;  8  Marital Status
  1.  S ^TMP("ORDATA",$J,1,"WP",8)="8^"_$P(VADM(10),"^",2)
  1.  ;  9  Phone Number
  1.  S ^TMP("ORDATA",$J,1,"WP",9)="9^"_VAPA(8)
  1.  ;  10  Street Address (1-3), City, State, and ZIP
  1.  S ^TMP("ORDATA",$J,1,"WP",10,1)="10^"_VAPA(1) I $P(^(1),"^",2)="" K ^(1)
  1.  S ^TMP("ORDATA",$J,1,"WP",10,2)="10^"_VAPA(2) I $P(^(2),"^",2)="" K ^(2)
  1.  S ^TMP("ORDATA",$J,1,"WP",10,3)="10^"_VAPA(3) I $P(^(3),"^",2)="" K ^(3)
  1.  S ^TMP("ORDATA",$J,1,"WP",10,4)="10^"_VAPA(4)_$S($G(VAPA(4))'="":", ",1:"")_$P(VAPA(5),"^",2)_" "_VAPA(6)
  1.  ; 12  Ethnicity
  1.  S I=0 F  S I=$O(VADM(11,I)) Q:+I=0  D
  1.  . S ORDAT=$P(VADM(11,I),"^",2) Q:'$L(ORDAT)
  1.  . S ORETHN=$G(ORETHN)_", "_ORDAT
  1.  . S ^TMP("ORDATA",$J,1,"WP",12,I)="12^"_ORDAT
  1.  ; 11  Race
  1.  S:$L(ORETHN) ^TMP("ORDATA",$J,1,"WP",11,1)="11^"
  1.  S I=0 F  S I=$O(VADM(12,I)) Q:+I=0  D
  1.  . S ORDAT=$P($G(VADM(12,I)),"^",2) Q:'$L(ORDAT)
  1.  . S ORRACE=$G(ORRACE)_", "_ORDAT
  1.  . S ^TMP("ORDATA",$J,1,"WP",11,I)="11^"_ORDAT
  1.  S ORRACE=$P(ORRACE,", ",2,$L(ORRACE,", "))
  1.  I '$L($P($G(^TMP("ORDATA",$J,1,"WP",12,1)),"^",2)) D
  1.  . I '$L($P($G(^TMP("ORDATA",$J,1,"WP",11,1)),"^",2)) D
  1.  . . S ^TMP("ORDATA",$J,1,"WP",12,1)="12^"
  1.  . . S ^TMP("ORDATA",$J,1,"WP",11,1)="11^"_$P($G(VADM(8)),"^",2)
  1.  S ORETHN=$P(ORETHN,", ",2,$L(ORETHN,", "))
  1.  ; 13  Next of Kin
  1.  S ^TMP("ORDATA",$J,1,"WP",13)="13^"_VAOA(9)
  1.  ; 13  Next of Kin Relationship
  1.  S ^TMP("ORDATA",$J,1,"WP",14)="14^"_VAOA(10)
  1.  ; 14  NOK Street Address (1-3), City, State, and ZIP
  1.  S ^TMP("ORDATA",$J,1,"WP",15,1)="15^"_VAOA(1) I $P(^(1),"^",2)="" K ^(1)
  1.  S ^TMP("ORDATA",$J,1,"WP",15,2)="15^"_VAOA(2) I $P(^(2),"^",2)="" K ^(2)
  1.  S ^TMP("ORDATA",$J,1,"WP",15,3)="15^"_VAOA(3) I $P(^(3),"^",2)=""
  1.  S ^TMP("ORDATA",$J,1,"WP",15,4)="15^"_VAOA(4)_$S($G(VAOA(4))'="":", ",1:"")_$P(VAOA(5),"^",2)_" "_VAOA(6)
  1.  ; 15  Security Log
  1.  S ^TMP("ORDATA",$J,1,"WP",16)="16^"_$S($P($G(^DGSL(38.1,DFN,0)),"^",2):"YES",1:"NO")
  1.  S ROOT=$NA(^TMP("ORDATA",$J))
  1.  Q
  1. ICDSUR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return ICD Surgery Information
  1.  ;External calls to VASITE, GMTSDGP
  1.  N ORSITE,SITE,T1,T2,I,J,GMS,PTF,ORDATE
  1.  K ^TMP("ORDATA",$J)
  1.  S T1=ORDEND,T2=ORDBEG,ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
  1.  F PTF=0:0 S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF=""  D ICDS^GMTSDGP
  1.  S (I,ORDATE)=0
  1.  F  S ORDATE=$O(GMS(ORDATE)) Q:ORDATE=""!(I'<ORMAX)  S J=0 D
  1.  . F  S J=$O(GMS(ORDATE,J))  Q:'J!(I'<ORMAX)  S I=I+1 D  ;Check for multiple procedures on same date
  1.  .. S SITE=$S($L($G(GMS(ORDATE,J,"facility"))):^("facility"),1:ORSITE)
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,1)="1^"_SITE
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,2)="2^"_$$DATEMMM^ORDVU($P(GMS(ORDATE),"  ",3)) ;Date of procedure
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,3)="3^"_$P($G(GMS(ORDATE,J)),"^") ;Surgery and code
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,4)="4^"_$P(GMS(ORDATE,J),"^",2) ;ICD code
  1.  S ROOT=$NA(^TMP("ORDATA",$J))
  1.  Q
  1. PRC(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Return Procedure Information
  1.  ;External calls to VASITE, GMTSDGP
  1.  N ORSITE,SITE,T1,T2,I,J,GMP,PTF,ORDATE
  1.  K ^TMP("ORDATA",$J)
  1.  S T1=ORDEND,T2=ORDBEG,PTF=0,ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
  1.  F  S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF=""  D ICDP^GMTSDGP
  1.  S (I,ORDATE)=0
  1.  F  S ORDATE=$O(GMP(ORDATE)) Q:ORDATE=""!(I'<ORMAX)  S J=0 D
  1.  . F  S J=$O(GMP(ORDATE,J))  Q:'J!(I'<ORMAX)  S I=I+1 D  ;Check for multiple procedures on same date
  1.  .. S SITE=$S($L($G(GMP(ORDATE,J,"facility"))):^("facility"),1:ORSITE)
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,1)="1^"_SITE
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,2)="2^"_$$DATEMMM^ORDVU($P(GMP(ORDATE),"  ",2)) ;Date of procedure
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,3)="3^"_$P($G(GMP(ORDATE,J)),"^") ;Procedure and code
  1.  .. S ^TMP("ORDATA",$J,"WP",ORDATE,J,4)="4^"_$P(GMP(ORDATE,J),"^",2) ;ICD code
  1.  S ROOT=$NA(^TMP("ORDATA",$J))
  1.  Q
  1. 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
  1.  N ORSITE,SITE,ORARRAY,I
  1.  K ^TMP("ORDATA",$J)
  1.  D ALL^IBCNS1(DFN,"ORARRAY")
  1.  Q:'$D(ORARRAY)  ;quit if no insurance data returned
  1.  S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3),I=0
  1.  F  S I=$O(ORARRAY(I)) Q:'I  D
  1.  . S SITE=$S($L($G(ORARRAY(I,"facility"))):^("facility"),1:ORSITE)
  1.  . S ^TMP("ORDATA",$J,"WP",I,1)="1^"_SITE
  1.  . S ^TMP("ORDATA",$J,"WP",I,2)="2^"_$P($G(^DIC(36,+$P(ORARRAY(I,0),"^"),0)),"^") ;Insurance company
  1.  . S ^TMP("ORDATA",$J,"WP",I,3)="3^"_$P($G(^IBE(355.1,+$P(ORARRAY(I,355.3),"^",9),0)),"^") ;Policy type
  1.  . S ^TMP("ORDATA",$J,"WP",I,4)="4^"_$P(ORARRAY(I,355.3),"^",4) ;Group number
  1.  . 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
  1.  . S ^TMP("ORDATA",$J,"WP",I,6)="6^"_$$DATE^ORDVU($P(ORARRAY(I,0),"^",8)) ;Effective date of policy
  1.  . S ^TMP("ORDATA",$J,"WP",I,7)="7^"_$$DATE^ORDVU($P(ORARRAY(I,0),"^",4)) ;Expiration date of policy
  1.  S ROOT=$NA(^TMP("ORDATA",$J))
  1.  Q