SDECELG ;SPFO/DMR SCHEDULING ENHANCEMENTS VSE API
;;5.3;Scheduling;**669,671**;Aug 13 1993;Build 25
;
;This API gets the all patient eligibility
;
Q
START(RRN,DFN) ;
S (NM,NM2,MECN,VET,VET1,ELGN,REO,RRN)=""
;
S ELGN=0 F S ELGN=$O(^DPT(DFN,"E",ELGN)) Q:ELGN="B"!(ELGN="") D
.S NM="" S NM=$P(^DIC(8,ELGN,0),"^",1)
.Q:NM="" S MECN="" S MECN=$P($G(^DIC(8,ELGN,0)),"^",9)
.Q:'$G(MECN) S NM2="" S NM2=$P(^DIC(8.1,MECN,0),"^",1)
.Q:'$D(NM2) S (VET,VET1)="" S VET=$P(^DIC(8.1,MECN,0),"^",5)
.Q:'$D(VET) S VET1=$S(VET="N":"NON-VETERAN",VET="Y":"VETERAN")
.S REO=":"_ELGN_"^"_NM_"^"_NM2_"^"_VET1
.S RRN=RRN_REO
.Q
K NM,NM2,MECN,VET,VET1,ELGN,REO
Q
ELIG(RTN,PTIEN,CLIEN,ADT) ;
N NM1,NM3,MECN1,VET2,VET3,ELIG1,HLAP0,HLAPIEN
S RTN=""
;
S ECODE=""
S HLAPIEN=+$$FIND^SDAM2(PTIEN,ADT,CLIEN) I HLAPIEN'="" D
.S HLAP0=$G(^SC(CLIEN,"S",ADT,1,HLAPIEN,0))
.I HLAP0'="" D
..S ECODE=$P($G(HLAP0),"^",10)
I ECODE="" S ECODE=$P(^DPT(PTIEN,.36),"^")
;
S NM1="" S NM1=$P(^DIC(8,ECODE,0),"^",1) Q:NM1="" D
.Q:NM1="" S MECN1="" S MECN1=$P($G(^DIC(8,ECODE,0)),"^",9)
.Q:'$G(MECN1) S NM3="" S NM3=$P(^DIC(8.1,MECN1,0),"^",1)
.Q:'$D(NM3) S (VET2,VET3)="" S VET2=$P(^DIC(8.1,MECN1,0),"^",5)
.Q:'$D(VET2) S VET3=$S(VET2="N":"NON-VETERAN",VET2="Y":"VETERAN")
.S RTN=":"_ECODE_"^"_NM1_"^"_NM3_"^"_VET3
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECELG 1357 printed Nov 22, 2024@18:02:02 Page 2
SDECELG ;SPFO/DMR SCHEDULING ENHANCEMENTS VSE API
+1 ;;5.3;Scheduling;**669,671**;Aug 13 1993;Build 25
+2 ;
+3 ;This API gets the all patient eligibility
+4 ;
+5 QUIT
START(RRN,DFN) ;
+1 SET (NM,NM2,MECN,VET,VET1,ELGN,REO,RRN)=""
+2 ;
+3 SET ELGN=0
FOR
SET ELGN=$ORDER(^DPT(DFN,"E",ELGN))
if ELGN="B"!(ELGN="")
QUIT
Begin DoDot:1
+4 SET NM=""
SET NM=$PIECE(^DIC(8,ELGN,0),"^",1)
+5 if NM=""
QUIT
SET MECN=""
SET MECN=$PIECE($GET(^DIC(8,ELGN,0)),"^",9)
+6 if '$GET(MECN)
QUIT
SET NM2=""
SET NM2=$PIECE(^DIC(8.1,MECN,0),"^",1)
+7 if '$DATA(NM2)
QUIT
SET (VET,VET1)=""
SET VET=$PIECE(^DIC(8.1,MECN,0),"^",5)
+8 if '$DATA(VET)
QUIT
SET VET1=$SELECT(VET="N":"NON-VETERAN",VET="Y":"VETERAN")
+9 SET REO=":"_ELGN_"^"_NM_"^"_NM2_"^"_VET1
+10 SET RRN=RRN_REO
+11 QUIT
End DoDot:1
+12 KILL NM,NM2,MECN,VET,VET1,ELGN,REO
+13 QUIT
ELIG(RTN,PTIEN,CLIEN,ADT) ;
+1 NEW NM1,NM3,MECN1,VET2,VET3,ELIG1,HLAP0,HLAPIEN
+2 SET RTN=""
+3 ;
+4 SET ECODE=""
+5 SET HLAPIEN=+$$FIND^SDAM2(PTIEN,ADT,CLIEN)
IF HLAPIEN'=""
Begin DoDot:1
+6 SET HLAP0=$GET(^SC(CLIEN,"S",ADT,1,HLAPIEN,0))
+7 IF HLAP0'=""
Begin DoDot:2
+8 SET ECODE=$PIECE($GET(HLAP0),"^",10)
End DoDot:2
End DoDot:1
+9 IF ECODE=""
SET ECODE=$PIECE(^DPT(PTIEN,.36),"^")
+10 ;
+11 SET NM1=""
SET NM1=$PIECE(^DIC(8,ECODE,0),"^",1)
if NM1=""
QUIT
Begin DoDot:1
+12 if NM1=""
QUIT
SET MECN1=""
SET MECN1=$PIECE($GET(^DIC(8,ECODE,0)),"^",9)
+13 if '$GET(MECN1)
QUIT
SET NM3=""
SET NM3=$PIECE(^DIC(8.1,MECN1,0),"^",1)
+14 if '$DATA(NM3)
QUIT
SET (VET2,VET3)=""
SET VET2=$PIECE(^DIC(8.1,MECN1,0),"^",5)
+15 if '$DATA(VET2)
QUIT
SET VET3=$SELECT(VET2="N":"NON-VETERAN",VET2="Y":"VETERAN")
+16 SET RTN=":"_ECODE_"^"_NM1_"^"_NM3_"^"_VET3
+17 QUIT
End DoDot:1
+18 QUIT
