- 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 Mar 13, 2025@21:57: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
