HMPPATS ;SLC/MKB,ASMR/RRB,SRG - Patient Management Utilities ;Aug 29, 2016 20:06:27
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^SC 10040
; DICN 10009
; SDAMA301 4433
; XLFDT 10103
; XPAR 2263
Q
;
APPT ; -- Return patients w/appointments tomorrow
; OPT = HMP APPOINTMENTS
N NOW,NOW1,HMPX,HMPL,HMPN,DFN,DA,TOKEN,NEW,X
S NOW=$$NOW^XLFDT,NOW1=$$FMADD^XLFDT(NOW,1)
S HMPX(1)=NOW_";"_NOW1 ;next 24hours
S HMPX("FLDS")=1,HMPX("SORT")="P",HMPX(3)="R;I;NT"
; ck parameter for desired location(s): HMPX(2)="loc1;loc2;...;loc#"
D GETLST^XPAR(.HMPL,"ALL","HMP LOCATIONS") I +$G(HMPL) D
. ;DE2818, ^SC reference - ICR 10040, changed loop below to begin at 1
. F I=1:1:+HMPL S X=+$G(HMPL(I)) S:$D(^SC(X,0)) HMPX(2)=HMPX(2)_";"_X
S HMPN=$$SDAPI^SDAMA301(.HMPX) Q:HMPN<1
S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:'(DFN>0) D ;DE4496 19 August 2016
. S DA=0 F S DA=$O(^HMP(800000,DA)) Q:DA<1 I $P($G(^(DA,0)),U,2) D
.. Q:$D(^HMP(800000,"ADFN",DFN,DA)) ;already subscribed
.. S TOKEN=DA_"~"_NOW,NEW(TOKEN)=""
.. S ^XTMP("HMPX",TOKEN,DFN)=""
I $D(NEW) D SEND^HMPHTTP(.NEW) ;send poke to each URL with list TOKEN
Q
;
FIND(ID) ; -- Return ien of system ID in ^HMP
N DA,DO,DIC,X,Y
I $G(ID)="" Q 0 ;error
S DA=+$O(^HMP(800000,"B",ID,0)) I DA<1 D ;add
. S DIC="^HMP(800000,",DIC(0)="F",X=ID
. D FILE^DICN S DA=+Y
Q DA
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPPATS 1692 printed Oct 16, 2024@17:55:09 Page 2
HMPPATS ;SLC/MKB,ASMR/RRB,SRG - Patient Management Utilities ;Aug 29, 2016 20:06:27
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^SC 10040
+7 ; DICN 10009
+8 ; SDAMA301 4433
+9 ; XLFDT 10103
+10 ; XPAR 2263
+11 QUIT
+12 ;
APPT ; -- Return patients w/appointments tomorrow
+1 ; OPT = HMP APPOINTMENTS
+2 NEW NOW,NOW1,HMPX,HMPL,HMPN,DFN,DA,TOKEN,NEW,X
+3 SET NOW=$$NOW^XLFDT
SET NOW1=$$FMADD^XLFDT(NOW,1)
+4 ;next 24hours
SET HMPX(1)=NOW_";"_NOW1
+5 SET HMPX("FLDS")=1
SET HMPX("SORT")="P"
SET HMPX(3)="R;I;NT"
+6 ; ck parameter for desired location(s): HMPX(2)="loc1;loc2;...;loc#"
+7 DO GETLST^XPAR(.HMPL,"ALL","HMP LOCATIONS")
IF +$GET(HMPL)
Begin DoDot:1
+8 ;DE2818, ^SC reference - ICR 10040, changed loop below to begin at 1
+9 FOR I=1:1:+HMPL
SET X=+$GET(HMPL(I))
if $DATA(^SC(X,0))
SET HMPX(2)=HMPX(2)_";"_X
End DoDot:1
+10 SET HMPN=$$SDAPI^SDAMA301(.HMPX)
if HMPN<1
QUIT
+11 ;DE4496 19 August 2016
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",DFN))
if '(DFN>0)
QUIT
Begin DoDot:1
+12 SET DA=0
FOR
SET DA=$ORDER(^HMP(800000,DA))
if DA<1
QUIT
IF $PIECE($GET(^(DA,0)),U,2)
Begin DoDot:2
+13 ;already subscribed
if $DATA(^HMP(800000,"ADFN",DFN,DA))
QUIT
+14 SET TOKEN=DA_"~"_NOW
SET NEW(TOKEN)=""
+15 SET ^XTMP("HMPX",TOKEN,DFN)=""
End DoDot:2
End DoDot:1
+16 ;send poke to each URL with list TOKEN
IF $DATA(NEW)
DO SEND^HMPHTTP(.NEW)
+17 QUIT
+18 ;
FIND(ID) ; -- Return ien of system ID in ^HMP
+1 NEW DA,DO,DIC,X,Y
+2 ;error
IF $GET(ID)=""
QUIT 0
+3 ;add
SET DA=+$ORDER(^HMP(800000,"B",ID,0))
IF DA<1
Begin DoDot:1
+4 SET DIC="^HMP(800000,"
SET DIC(0)="F"
SET X=ID
+5 DO FILE^DICN
SET DA=+Y
End DoDot:1
+6 QUIT DA
+7 ;
