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

ONCOCON.m

Go to the documentation of this file.
  1. ONCOCON ;Hines OIFO/GWB - VADPT calls ;06/23/10
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;
  1. NOK ;NEXT OF KIN
  1. S XD0=D0 D VP G EX:OP=""
  1. N I,X
  1. D OAD^VADPT G EX:VAERR
  1. S ST=$S(VAOA(5)="":"",1:$P(^DIC(5,$P(VAOA(5),U),0),U,2)),CSZ=VAOA(4)
  1. I CSZ'="" S CSZ=CSZ_", "
  1. S CSZ=CSZ_ST_" "_VAOA(6),SP="?25" S:'$D(NOK) NOK="NOK"
  1. D WT
  1. G EX
  1. ;
  1. NOK1 ;NEXT OF KIN-1
  1. S NOK="NOK1" G NOK
  1. ;
  1. NOK2 ;NEXT OF KIN-2 #.2191
  1. S VAOA("A")=3,NOK="NOK2" G NOK
  1. ;
  1. CON ;Retrieve Contacts (NOK1 and NOK@)
  1. S XD0=D0 D VP G EX:OP="" N I,X D OAD^VADPT F I=1:1:10 S ONCO(I)=VAOA(I)
  1. K VAOA S VAOA("A")=3 D OAD^VADPT F I=1:1:10 S ONCO(I+10)=VAOA(I)
  1. G EX
  1. ;
  1. WT W !,@SP,NOK,": ",@SP,VAOA(10)
  1. 2 ;W !?25,VAOA(10)
  1. 3 W !,@SP,$P(VAOA(9),",",2)_" "_$P(VAOA(9),",")
  1. 4 W !,@SP,VAOA(1)
  1. 5 W:VAOA(2)'="" !,@SP,VAOA(2)
  1. 6 W:VAOA(3)'="" !,@SP,VAOA(3)
  1. W:CSZ'="" !,@SP,CSZ
  1. Q
  1. ;
  1. REL2 ;NOK2
  1. S VAOA("A")=3 G REL
  1. REL ;NOK relationship and Name
  1. S XD0=D0 D VP G EX:OP="" N I D OAD^VADPT G EX:VAERR S X=$S(VAOA(9)="":"",1:VAOA(10)_": "_$P(VAOA(9),",",2)_" "_$P(VAOA(9),",",1)_" * "_VAOA(1)) K ONCOD0 G EX:X="" I VAOA(2)'="" S X=X_" "_VAOA(2)
  1. S:VAOA(3)'="" X=X_" "_VAOA(3) S X=X_" "_VAOA(4)_", "_$P(VAOA(5),U,2)_" "_VAOA(6) G EX
  1. ;
  1. ADM ;Admission date/Discharge date
  1. ;FOR NON-DHCP (EAST-ORANGE)
  1. S (ONCOAD,ONCODD)="" I $G(^DG(43,1,"VERSION"))<4.6 Q ;FOR NON-DHCP EAST-ORANGE
  1. S XX=$S($D(^ONCO(165.5,D0,0)):^(0),1:"") Q:XX="" S XD0=$P(XX,U,2) D VP Q:OP="" S XD=$P(XX,U,16),VAIP("D")=$S(XD="":"L",1:XD)
  1. A5 I $G(^DG(43,1,"VERSION"))>4.8 N I,X D IN5 G:VAIP(1)'="" SV G:XD="" EX G NO
  1. A4 G:XD="" EX S VAINDT=XD N I,X D INP G:VAIN(1)="" NO G SV
  1. ;
  1. SV S ONCOAD=AD,ONCODD=XD
  1. WE W !!?15,"Admission: ",AD_" Discharge: "_XD,! G EX
  1. NO D DD W !,"No admission for ",XD G EX
  1. ;
  1. INP ;MAS VERSIONS less than 5.0
  1. N I,X D INP^VADPT Q:VAIN(1)="" S XD=$P($P(VAIN(7),U),".") D DD S AD=XD,XD=$S($D(^DPT(DFN,"DA",VAIN(1),1)):$P(^(1),U),1:"") D DD Q
  1. ;
  1. NOKEO ;COMPUTED EXPRESSION for NOK (160,.214)
  1. ;Displays K-NAME OF PRIMARY NOK (2,.211) and
  1. ; K-RELATIONSHIP TO PATIENT (2,.212)
  1. N RCDT
  1. I $D(^ONCO(160,D0,0)) S RCDT=^(0) I $P(RCDT,";",2)["DPT",$D(^DPT($P(RCDT,";",1),.21)) W $P(^(.21),U)_" ("_$P(^(.21),U,2)_")"
  1. Q
  1. ;
  1. SAD ;COMPUTED EXPRESSION for SUSPENSE ADMIT DATE (160,33.1)
  1. D SUS S X=$S($D(XAD):XAD,1:"")
  1. G EX
  1. ;
  1. SDD ;COMPUTED EXPRESSION for SUSPENSE DISCHARGE DATE (160,33.2)
  1. D SUS S X=$S($D(XDD):XDD,1:"")
  1. G EX
  1. ;
  1. SEC ;COMPUTED EXPRESSION for SUSPENSE EPISODE OF CARE (160,33.3)
  1. D SUS S X="" G:SD="" EX I '$D(AD) S XD=SD G NO
  1. S XD=$S($D(XD):XD,1:"") G WE
  1. ;
  1. SUS ;SUSPENSE EPISODE OF CARE
  1. S XD0=D0,SD=""
  1. S SDIEN=$O(^ONCO(160,XD0,"SUS","C",DUZ(2),""))
  1. I SDIEN'="" S SD=$P($G(^ONCO(160,XD0,"SUS",SDIEN,0)),"^",1)
  1. Q:SD="" D VP Q:OP=""
  1. S VAIP("D")=SD D IN5
  1. Q
  1. ;
  1. LEC ;COMPUTED EXPRESSION for LAST EPISODE of CARE (160,34)
  1. D LST
  1. I '$D(AD) W "No admission data" G EX
  1. I $D(XD) I XD'="" W "Admission: ",AD_" Discharge: "_XD G EX
  1. W "Admission: "_AD_" (Active)" G EX
  1. ;
  1. LAD ;COMPUTED EXPRESSION for LAST ADMIT DATE (160,34.1)
  1. D LST S X=$S($D(AD):AD,1:"")
  1. G EX
  1. ;
  1. LDD ;COMPUTED EXPRESSION for LAST DISCHARGE DATE (160,34.2)
  1. D LST S X=$S($D(XD):XD,1:"")
  1. G EX
  1. ;
  1. LST ;Get ADMISSION and DISCHARGE data
  1. S XD0=D0 D VP G:OP="" EX
  1. S VAIP("D")="L"
  1. D IN5
  1. Q
  1. ;
  1. VP ;Resolve NAME (160,.01) variable pointer
  1. S OP=$S($D(^ONCO(160,XD0,0)):$P(^(0),U),1:"")
  1. S DFN=$P(OP,";",1)
  1. S OF=$P(OP,";",2)
  1. S OP=$S(OF="LRT(67,":"",1:OP)
  1. Q
  1. ;
  1. IN5 ;Call IN5^VADPT (Inpatient Data [v5.0 and above])
  1. N X
  1. D IN5^VADPT Q:VAIP(1)=""
  1. S XD=$P(VAIP(13,1),".") D DD S AD=XD
  1. S XD=$P(VAIP(17,1),".") D DD S XD=XD
  1. Q
  1. ;
  1. DD ;Format date as mm/dd/yy
  1. S XD=$S(XD="":XD,1:$E(XD,4,5)_"/"_$E(XD,6,7)_"/"_$E(XD,2,3))
  1. Q
  1. ;
  1. EX ;Exit
  1. K AD,CSZ,DFN,NOK,OF,ONCO,ONCOAD,ONCODD,OP,RCDT,SD,SDIEN,SP,ST
  1. K VAERR,VAIN,VAIP,VAINDT,VAOA,XAD,XD,XDD,XX,XD0
  1. Q
  1. ;
  1. CLEANUP ;Cleanup
  1. K D0