AHHOBJ2 ;NCH/RLP TIU Object Patient Extract 17-Jul-01
;;1.0;NCH Object
;--- Object: Future Appointments for a Patient ---
;
; --- for testing object ---
P68 S DFN=68 W $$FUTAPP(DFN,"^TMP(""APMT"",$J)",30,1) Q
P70 S DFN=70 W $$FUTAPP(DFN,"^TMP(""APMT"",$J)",30,1) Q
P259 S DFN=259 W $$FUTAPP(DFN,"^TMP(""APMT"",$J)",60,1) Q
Q
;
;
FUTAPP(DFN,TARGET,DAYS,DISPLAY) ; --- Object calls this line tag ---
;
I +$G(DISPLAY) W !,"<<< Checking for Future Appointments >>>"
;
N ApmtDate,Clinic,CrntDate,DPTSNode,Dash,ExtDate,FromDate
N HaveData,Result,SC0Node,ToDate
;
K @TARGET
S HaveData=0
S $P(Dash,"=",60)=""
;
D NOW^%DTC S (ApmtDate,CrntDate)=X
S Y=CrntDate D DD^%DT S FromDate=Y
S X1=CrntDate,X2=DAYS D C^%DTC S (EndDate,Y)=X D DD^%DT S ToDate=Y
;
LOOP F S ApmtDate=$O(^DPT(DFN,"S",ApmtDate)) Q:'ApmtDate!(ApmtDate>EndDate)
D ;
. I $D(^DPT(DFN,"S",ApmtDate,0)) D ;
. . S DPTSNode=$G(^DPT(DFN,"S",ApmtDate,0))
. . I $D(^SC(+DPTSNode,0)) D ;
. . . S SC0Node=$G(^SC(+DPTSNode,0))
. . . S Clinic=$P(SC0Node,"^",1)
. . . S Y=ApmtDate D DD^%DT S ExtDate=Y
. . . S Result=" "_ExtDate_" "_Clinic
. . . S @TARGET@(ApmtDate,0)=Result
. . . S HaveData=1
;
HEADNG I HaveData D ;
. S @TARGET@(1,0)="Future Appointments from: "_FromDate
. S @TARGET@(2,0)=" To: "_ToDate
. S @TARGET@(3,0)=Dash
E S @TARGET@(1,0)="No Future Appointments from "_FromDate_" to "_ToDate
Q "~@"_$NA(@TARGET)