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

SDPHARM.m

Go to the documentation of this file. 
  1. SDPHARM ;ALBANY OIFO/KEITH - Determine patients for Rx benefit ; 6/30/03
  1.  ;;5.3;Scheduling;**300,1015**;AUG 13,1993;Build 21
  1. LOOK ;Search PATIENT file for eligible patients
  1.  ;
  1.  N DFN,SDPT,SDSS,SDATE,SDATE2
  1.  D INIT
  1.  ;
  1.  ;Roll through patient file
  1.  S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:'DFN  S SDPT=$$PAT(DFN)
  1.  Q
  1.  ;
  1. INIT ; Initialize variables
  1.  ;INPUT: SDL=lag for future date (optional) (Now date is hard set)
  1.  ;
  1.  N SDI,SDII
  1.  S SDATE=3031021.2359
  1.  S SDATE2=3011021.2359
  1.  ;Create primary care DSS credit pair array
  1.  F SDI=322,323,350 F SDII="000",185,186,187 S SDSS(SDI_SDII)=""
  1.  Q
  1.  ;
  1. PAT(DFN) ;Evaluate a patient
  1.  ;INPUT:  DFN=patient ien
  1.  ;OUTPUT: (fail) 0^_<reason for failure>
  1.  ;        (success) 1^Patient appears to be eligible
  1.  ;
  1.  N SDAP0,SDCL0,SDCP,SDEN,SDEN0,SDIV,SDOUT,SDT
  1.  ;
  1.  Q:$D(^PS(52.91,DFN,0)) "0^Patient is already in TPB ELIGIBILITY File"
  1.  Q:'$D(^DPT(DFN,0)) "0^Patient recird not found"
  1.  Q:'$O(^DPT(DFN,"S",SDATE)) "0^No appointment later than 10/21/03"
  1.  Q:+$G(^DPT(DFN,.35)) "0^Patient is deceased"
  1.  Q:$P($G(^DPT(DFN,"VET")),U)'="Y" "0^Patient is not a veteran"
  1.  ;Should we not quit in next line if date is in future
  1.  Q:+$P($G(^DPT(DFN,.15)),U,2) "0^Patient is ineligible"
  1.  Q:'$L($P($G(^DPT(DFN,0)),U)) "0^Invalid name value"
  1.  Q:$D(^DPT(DFN,-9)) "0^Merged patient record"
  1.  Q:$P(^DPT(DFN,0),U)["MERGING INTO" "0^Merging patient record"
  1.  Q:$E($P(^DPT(DFN,0),U,9),1,5)="00000" "0^Test patient"
  1.  ;Next 2 checks have been moved to the Pharmacy routine
  1.  ;Q:'$$DATE^ENROLD(DFN) "0^Not enrolled by date required"
  1.  ;Q:$$RX^PSOGAPBL(DFN) "0^Active prescriptions exist"
  1.  S SDT=SDATE,SDOUT=0
  1.  F  S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT  D
  1.  .S SDAP0=$G(^DPT(DFN,"S",SDT,0)) Q:'+SDAP0  ;Get appt 0 node
  1.  .Q:$P(SDAP0,U,2)["C"  ;Skip cancelled appointments
  1.  .Q:'$P(SDAP0,U,19)  ;Need 'date entered'
  1.  .Q:$P(SDAP0,U,19)>3030724
  1.  .S SDCL0=$G(^SC(+SDAP0,0)) Q:'$L(SDCL0)  ;Get clinic 0 node
  1.  .S SDCP=$$CPAIR(SDCL0)  ;Get DSS credit pair
  1.  .Q:'$D(SDSS(SDCP))  ;Not a primary care appointment
  1.  .S SDIV=$$DIV(SDCL0)  ;Get clinic division
  1.  .Q:$G(SDIV)'>0  ;No Institution
  1.  .I $$FMDIFF^XLFDT(SDT,$P(SDAP0,"^",19),1)<31 S ^XTMP("SDPSO145","PAT","S",DFN,SDIV,SDT)="1^0^"_$P($G(^DPT(DFN,"S",SDT,1)),"^") Q
  1.  .S ^XTMP("SDPSO145","PAT","S",DFN,SDIV,SDT)="0^0^"_$P($G(^DPT(DFN,"S",SDT,1)),"^")
  1.  .Q
  1.  Q:'$D(^XTMP("SDPSO145","PAT","S",DFN)) "0^No future primary care appointment"
  1.  ;Examine past encounters
  1.  S SDT=SDATE2 F  S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!SDOUT  D
  1.  .S SDEN=0 F  S SDEN=$O(^SCE("ADFN",DFN,SDT,SDEN)) Q:'SDEN!SDOUT  D
  1.  ..S SDEN0=$G(^SCE(SDEN,0)) Q:'$L(SDEN0)  ;Get encounter 0 node
  1.  ..Q:$P(SDEN0,U,6)  ;Child encounter
  1.  ..Q:'$P(SDEN0,"^",4)
  1.  ..S SDCL0=$G(^SC(+$P(SDEN0,U,4),0)) Q:'$L(SDCL0)  ;Get clinic 0 node
  1.  ..S SDCP=$$CPAIR(SDCL0)  ;Get DSS credit pair 
  1.  ..Q:'$D(SDSS(SDCP))  ;Not a primary care encounter 
  1.  ..;S SDIV=$$DIV(SDCL0)  ;Get clinic division 
  1.  ..K ^XTMP("SDPSO145","PAT","S",DFN) S SDOUT=1  ;Kill all entries for that patient
  1.  ..;S:'$D(^XTMP("SDPSO145","PAT","S",DFN)) SDOUT=1  ;Quit if no future pc appts left
  1.  ..Q
  1.  .Q
  1.  Q:SDOUT "0^Patient has a Primary Care encounter within past 2 years"
  1.  Q "1^Patient appears to be eligible"
  1.  ;
  1. CPAIR(SDCL0) ;Get credit pair
  1.  ;Input: SDCL0=hospital location zeroeth node
  1.  N SDX
  1.  S SDX=$P($G(^DIC(40.7,+$P(SDCL0,U,7),0)),U,2)
  1.  S SDX=SDX_$P($G(^DIC(40.7,+$P(SDCL0,U,18),0)),U,2)
  1.  ;S:'$L(SDX) SDX="000000"
  1.  S SDX=$E(SDX_"000000",1,6)
  1.  Q SDX
  1.  ;
  1. DIV(SDCL0) ;Get facility division name and number
  1.  ;Input: SDCL0=hospital location zeroeth node
  1.  N SDIVV,SDHOLD S SDIVV=$P(SDCL0,U,15)
  1.  S SDHOLD=0
  1.  I SDIVV>0 S SDHOLD=$P($$SITE^VASITE(,SDIVV),"^")
  1.  I SDHOLD>0 Q SDHOLD
  1.  S SDHOLD=$P(SDCL0,"^",4)
  1.  I 'SDHOLD Q 0
  1.  I SDHOLD,'$D(^DIC(4,SDHOLD,0)) S SDHOLD=0
  1.  Q SDHOLD