- 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 Feb 18, 2025@23:20:50 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 ;