SDECPAT3 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
AGE(DFN,D,F) ;EP - Given DFN, return Age.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
I $$DOB^SDECPAT(DFN,"")<0 Q -1
;S:$G(D)="" D=DT ;IHS/CMI/LAB - added DOD check patch 8
S:$G(D)="" D=$S(+$$DOD^SDECPAT3(DFN):$$DOD^SDECPAT3(DFN),1:DT)
S:$G(F)="" F="Y"
N %,%1
S %=$$FMDIFF^XLFDT(D,$$DOB^SDECPAT(DFN,""))
S %1=%\365.25
I F="Y" Q %1
Q $S(%1>2:%1_" YRS",%<31:%_" DYS",1:%\30_" MOS")
;
CDEATH(DFN,F) ;EP - returns Cause of Death in F format
;F="E":ICD narrative, F="I":ien of icd code, F="C":icd code
I '$G(DFN) Q ""
I '$D(^AUPNPAT(DFN)) Q ""
I '$P($G(^AUPNPAT(DFN,11)),"^",14) Q ""
I '$D(^ICD9($P(^AUPNPAT(DFN,11),"^",14))) Q ""
S F=$G(F)
I F="I" Q $P(^AUPNPAT(DFN,11),"^",14)
I F="E" Q $P($$ICDDX^ICDCODE($P(^AUPNPAT(DFN,11),"^",14),$S($P($G(^DPT(DFN,.35)),U,1)]"":$P(^DPT(DFN,.35),U,1),1:DT)),"^",2) ;CSV
Q $P($$ICDDX^ICDCODE($P(^AUPNPAT(DFN,11),"^",14)),"^",2)
;
DOB(DFN,F) ;EP - Given DFN, return Date of Birth according to F.
; If F="E" produce the External form, else FM format.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
S F=$G(F)
;beginning Y2K mods - change 2 parameter is FMTE call to 5
;Q $S(F="E":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3),2),1:$P(^DPT(DFN,0),"^",3)) ;Y2000 IHS/CMI/LAB - commented out
Q $S(F="E":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3),5),1:$P(^DPT(DFN,0),"^",3)) ;Y2000 IHS/CMI/LAB
;end Y2K mods
;
DOD(DFN,F) ;EP - Given DFN, return Date of Death according to F.
; If F="E" produce the External form, else FM format.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
S F=$G(F)
Q $S(F="E":$$FMTE^XLFDT($P($G(^DPT(DFN,.35)),"^")),1:$P($G(^DPT(DFN,.35)),"^"))
;
ELIGSTAT(DFN,F) ;EP - returns eligibility status in F format
;F="E":eligibility type (name), F="I":internal set of codes
I '$G(DFN) Q -1
I '$D(^AUPNPAT(DFN,11)) Q -1
S F=$G(F)
Q $S(F="E":$$EXTSET^SDECFUNC(9000001,1112,$P(^AUPNPAT(DFN,11),"^",12)),1:$P(^AUPNPAT(DFN,11),"^",12))
;
HRN(DFN,L,F) ;EP - return HRN at L location
;L must be ien of location of encounter
;F is optional. If F=2 hrn will be prefixed with site abbreviation
I '$G(DFN) Q -1
I '$D(^AUPNPAT(DFN)) Q -1
I '$G(L) Q -1
I $G(F)=2,'$D(^AUTTLOC(L,0)) Q -1
Q $S($D(^AUPNPAT(DFN,41,L,0)):$S($G(F)=2:$P(^AUTTLOC(L,0),"^",7)_" ",1:"")_$P(^AUPNPAT(DFN,41,L,0),"^",2),1:"")
Q $P($G(^AUPNPAT(DFN,41,L,0)),"^",2)
;
SEX(DFN) ;EP - Given DFN, return Sex.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
Q $P(^DPT(DFN,0),"^",2)
;
SSN(DFN) ;EP - Given DFN, return SSN.
I '$G(DFN) Q -1
I '$D(^DPT(DFN,0)) Q -1
Q $P(^DPT(DFN,0),"^",9)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECPAT3 2766 printed Oct 16, 2024@18:52:55 Page 2
SDECPAT3 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
AGE(DFN,D,F) ;EP - Given DFN, return Age.
+1 IF '$GET(DFN)
QUIT -1
+2 IF '$DATA(^DPT(DFN,0))
QUIT -1
+3 IF $$DOB^SDECPAT(DFN,"")<0
QUIT -1
+4 ;S:$G(D)="" D=DT ;IHS/CMI/LAB - added DOD check patch 8
+5 if $GET(D)=""
SET D=$SELECT(+$$DOD^SDECPAT3(DFN):$$DOD^SDECPAT3(DFN),1:DT)
+6 if $GET(F)=""
SET F="Y"
+7 NEW %,%1
+8 SET %=$$FMDIFF^XLFDT(D,$$DOB^SDECPAT(DFN,""))
+9 SET %1=%\365.25
+10 IF F="Y"
QUIT %1
+11 QUIT $SELECT(%1>2:%1_" YRS",%<31:%_" DYS",1:%\30_" MOS")
+12 ;
CDEATH(DFN,F) ;EP - returns Cause of Death in F format
+1 ;F="E":ICD narrative, F="I":ien of icd code, F="C":icd code
+2 IF '$GET(DFN)
QUIT ""
+3 IF '$DATA(^AUPNPAT(DFN))
QUIT ""
+4 IF '$PIECE($GET(^AUPNPAT(DFN,11)),"^",14)
QUIT ""
+5 IF '$DATA(^ICD9($PIECE(^AUPNPAT(DFN,11),"^",14)))
QUIT ""
+6 SET F=$GET(F)
+7 IF F="I"
QUIT $PIECE(^AUPNPAT(DFN,11),"^",14)
+8 ;CSV
IF F="E"
QUIT $PIECE($$ICDDX^ICDCODE($PIECE(^AUPNPAT(DFN,11),"^",14),$SELECT($PIECE($GET(^DPT(DFN,.35)),U,1)]"":$PIECE(^DPT(DFN,.35),U,1),1:DT)),"^",2)
+9 QUIT $PIECE($$ICDDX^ICDCODE($PIECE(^AUPNPAT(DFN,11),"^",14)),"^",2)
+10 ;
DOB(DFN,F) ;EP - Given DFN, return Date of Birth according to F.
+1 ; If F="E" produce the External form, else FM format.
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^DPT(DFN,0))
QUIT -1
+4 SET F=$GET(F)
+5 ;beginning Y2K mods - change 2 parameter is FMTE call to 5
+6 ;Q $S(F="E":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($P(^DPT(DFN,0),"^",3),2),1:$P(^DPT(DFN,0),"^",3)) ;Y2000 IHS/CMI/LAB - commented out
+7 ;Y2000 IHS/CMI/LAB
QUIT $SELECT(F="E":$$FMTE^XLFDT($PIECE(^DPT(DFN,0),"^",3)),F="S":$$FMTE^XLFDT($PIECE(^DPT(DFN,0),"^",3),5),1:$PIECE(^DPT(DFN,0),"^",3))
+8 ;end Y2K mods
+9 ;
DOD(DFN,F) ;EP - Given DFN, return Date of Death according to F.
+1 ; If F="E" produce the External form, else FM format.
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^DPT(DFN,0))
QUIT -1
+4 SET F=$GET(F)
+5 QUIT $SELECT(F="E":$$FMTE^XLFDT($PIECE($GET(^DPT(DFN,.35)),"^")),1:$PIECE($GET(^DPT(DFN,.35)),"^"))
+6 ;
ELIGSTAT(DFN,F) ;EP - returns eligibility status in F format
+1 ;F="E":eligibility type (name), F="I":internal set of codes
+2 IF '$GET(DFN)
QUIT -1
+3 IF '$DATA(^AUPNPAT(DFN,11))
QUIT -1
+4 SET F=$GET(F)
+5 QUIT $SELECT(F="E":$$EXTSET^SDECFUNC(9000001,1112,$PIECE(^AUPNPAT(DFN,11),"^",12)),1:$PIECE(^AUPNPAT(DFN,11),"^",12))
+6 ;
HRN(DFN,L,F) ;EP - return HRN at L location
+1 ;L must be ien of location of encounter
+2 ;F is optional. If F=2 hrn will be prefixed with site abbreviation
+3 IF '$GET(DFN)
QUIT -1
+4 IF '$DATA(^AUPNPAT(DFN))
QUIT -1
+5 IF '$GET(L)
QUIT -1
+6 IF $GET(F)=2
IF '$DATA(^AUTTLOC(L,0))
QUIT -1
+7 QUIT $SELECT($DATA(^AUPNPAT(DFN,41,L,0)):$SELECT($GET(F)=2:$PIECE(^AUTTLOC(L,0),"^",7)_" ",1:"")_$PIECE(^AUPNPAT(DFN,41,L,0),"^",2),1:"")
+8 QUIT $PIECE($GET(^AUPNPAT(DFN,41,L,0)),"^",2)
+9 ;
SEX(DFN) ;EP - Given DFN, return Sex.
+1 IF '$GET(DFN)
QUIT -1
+2 IF '$DATA(^DPT(DFN,0))
QUIT -1
+3 QUIT $PIECE(^DPT(DFN,0),"^",2)
+4 ;
SSN(DFN) ;EP - Given DFN, return SSN.
+1 IF '$GET(DFN)
QUIT -1
+2 IF '$DATA(^DPT(DFN,0))
QUIT -1
+3 QUIT $PIECE(^DPT(DFN,0),"^",9)
