- 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 Jan 18, 2025@03:53:29 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)