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

HMPPATS.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; ^SC 10040
  1. ; DICN 10009
  1. ; SDAMA301 4433
  1. ; XLFDT 10103
  1. ; XPAR 2263
  1. Q
  1. ;
  1. APPT ; -- Return patients w/appointments tomorrow
  1. ; OPT = HMP APPOINTMENTS
  1. N NOW,NOW1,HMPX,HMPL,HMPN,DFN,DA,TOKEN,NEW,X
  1. S NOW=$$NOW^XLFDT,NOW1=$$FMADD^XLFDT(NOW,1)
  1. S HMPX(1)=NOW_";"_NOW1 ;next 24hours
  1. S HMPX("FLDS")=1,HMPX("SORT")="P",HMPX(3)="R;I;NT"
  1. ; ck parameter for desired location(s): HMPX(2)="loc1;loc2;...;loc#"
  1. D GETLST^XPAR(.HMPL,"ALL","HMP LOCATIONS") I +$G(HMPL) D
  1. . ;DE2818, ^SC reference - ICR 10040, changed loop below to begin at 1
  1. . F I=1:1:+HMPL S X=+$G(HMPL(I)) S:$D(^SC(X,0)) HMPX(2)=HMPX(2)_";"_X
  1. S HMPN=$$SDAPI^SDAMA301(.HMPX) Q:HMPN<1
  1. S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:'(DFN>0) D ;DE4496 19 August 2016
  1. . S DA=0 F S DA=$O(^HMP(800000,DA)) Q:DA<1 I $P($G(^(DA,0)),U,2) D
  1. .. Q:$D(^HMP(800000,"ADFN",DFN,DA)) ;already subscribed
  1. .. S TOKEN=DA_"~"_NOW,NEW(TOKEN)=""
  1. .. S ^XTMP("HMPX",TOKEN,DFN)=""
  1. I $D(NEW) D SEND^HMPHTTP(.NEW) ;send poke to each URL with list TOKEN
  1. Q
  1. ;
  1. FIND(ID) ; -- Return ien of system ID in ^HMP
  1. N DA,DO,DIC,X,Y
  1. I $G(ID)="" Q 0 ;error
  1. S DA=+$O(^HMP(800000,"B",ID,0)) I DA<1 D ;add
  1. . S DIC="^HMP(800000,",DIC(0)="F",X=ID
  1. . D FILE^DICN S DA=+Y
  1. Q DA
  1. ;