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

GMTSPST5.m

Go to the documentation of this file. 
  1. GMTSPST5 ;HINES/RMS - TIU OBJECT FOR REMOTE ALLERGIES VIA RDI ;Aug 21, 2018@14:28
  1.  ;;2.7;Health Summary;**94**;Oct 20, 1995;Build 41
  1.  ;
  1.  ;Reference to ORRDI1 supported by DBIA 4659
  1.  ;Reference to ^XTMP("ORRDI","OUTAGE INFO" supported by DBIA 5440
  1.  ;
  1. ENHS ;ENTRY POINT FOR HEALTH SUMMARY OF REMOTE AND LOCAL ALLERGY/ADR DATA
  1.  N GMTSHDR,GMTSRET,GMTSALG,GMTSALGR,GMTSFAC,GMTSREAC,GMTSRDI,GMTSDOWN,GMTSSTAT,GMTSSMSG
  1.  Q:'$G(DFN)
  1.  S GMTSSMSG=""
  1.  ;Track usage of this routine
  1.  D ADD^GMTSPSTR("GMTSPST5")
  1.  ;
  1.  ;Get Remote Allergy/ADR Data
  1.  D RMTALG
  1.  I GMTSSTAT=1 D
  1.  .F GMTSALG=1:1:GMTSRET D
  1.  .. S GMTSFAC=$G(^XTMP("ORRDI","ART",DFN,GMTSALG,"FACILITY",0))
  1.  .. S GMTSREAC=$G(^XTMP("ORRDI","ART",DFN,GMTSALG,"GMRALLERGY",0))
  1.  .. Q:$$YESCHK
  1.  .. Q:GMTSFAC']""!(GMTSREAC']"")
  1.  .. S GMTSFAC=$P(GMTSFAC,"^",2)
  1.  .. S GMTSREAC=$P(GMTSREAC,U,2)
  1.  .. S GMTSALGR(GMTSFAC,GMTSREAC)=""
  1.  .S GMTSRET=$O(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",""),-1)
  1.  .F GMTSALG=1:1:+GMTSRET D
  1.  .. S GMTSFAC=$G(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",GMTSALG,"FACILITY",0))
  1.  .. S GMTSREAC=$G(^XTMP("ORRDI","ART",DFN,"ASSESSMENT",GMTSALG))
  1.  .. Q:$$YESCHK
  1.  .. Q:GMTSFAC']""!(GMTSREAC']"")
  1.  .. S GMTSFAC=$P(GMTSFAC,"^",2)
  1.  .. S GMTSREAC=$P(GMTSREAC,U,2)
  1.  .. S GMTSALGR(GMTSFAC,GMTSREAC)=""
  1.  ;
  1.  ;Get Local Allergy/ADR Data
  1.  N LOCFAC S LOCFAC=$P($$SITE^VASITE,"^",2)
  1.  N GMI,GMRAL D EN1^GMRADPT
  1.  ; HERE, 1=Allergy List, 0=NKA, NULL=No Assessment
  1.  I GMRAL=1 D
  1.  . S GMI=0 F  S GMI=$O(GMRAL(GMI)) Q:GMI'>0  S GMTSALGR(LOCFAC,$P(GMRAL(GMI),U,2))=""
  1.  I GMRAL=0 D
  1.  . S GMTSALGR(LOCFAC,"No Known Allergies")=""
  1.  I GMRAL="" D
  1.  . S GMTSALGR(LOCFAC,"No Allergy Assessment Completed")=""
  1.  ;
  1.  ;Display HS Component
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  W !,"FACILITY",?40,"ALLERGY/ADR",!,"--------",?40,"-----------"
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  I GMTSSTAT=0 D  ;Q   ;Took out QUIT here so local allergy info can display
  1.  .D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  .W !,GMTSSMSG
  1.  .D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  S GMTSFAC="" F  S GMTSFAC=$O(GMTSALGR(GMTSFAC)) Q:GMTSFAC']""  D  ;
  1.  . S GMTSREAC="" F  S GMTSREAC=$O(GMTSALGR(GMTSFAC,GMTSREAC)) Q:GMTSREAC']""  D  ;
  1.  .. D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  .. W !,$E(GMTSFAC,1,38),?40,GMTSREAC
  1.  .. D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  W ! D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  Q
  1.  ;
  1. RMTALG ;
  1.  ;ZEXCEPT: GMTSDOWN,GMTSHDR,GMTSREAC,GMTSRET,GMTSSMSG,GMTSSTAT
  1.  S GMTSSTAT=0
  1.  S GMTSSMSG=""
  1.  S GMTSHDR=$$HAVEHDR^ORRDI1 I '+$G(GMTSHDR) D  Q
  1.  . S GMTSSMSG="*** WARNING: Remote Data from HDR not available ***"
  1.  D  Q:$G(GMTSDOWN)
  1.  . I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) H $$GET^XPAR("ALL","ORRDI PING FREQ")/2
  1.  . I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) S GMTSDOWN=1 D
  1.  .. S GMTSSMSG="*** WARNING: Connection to Remote Data Currently Down ***"
  1.  D  ;RDI/HDR CALL ENCAPSULATION
  1.  . D SAVDEV^%ZISUTL("GMTSHFS")
  1.  . S GMTSRET=$$GET^ORRDI1(DFN,"ART")
  1.  . D USE^%ZISUTL("GMTSHFS")
  1.  . D RMDEV^%ZISUTL("GMTSHFS")
  1.  I GMTSRET=-1 D  Q
  1.  . S GMTSSMSG="*** WARNING: Connection to Remote Data Not Available ***"
  1.  I '$D(^XTMP("ORRDI","ART",DFN))!('+GMTSRET) D  Q
  1.  . I $D(^XTMP("ORRDI","ART",DFN,"ASSESSMENT")) S GMTSSTAT=1 Q
  1.  . S GMTSSMSG="No Remote Allergy/ADR Data available for this patient"
  1.  S GMTSSTAT=1
  1.  Q
  1.  ;
  1. YESCHK() ;DO NOT INCLUDE IF A 'YES' ASSESSMENT
  1.  I $P(GMTSREAC,U,2)'="YES" Q 0
  1.  I $P(GMTSREAC,U,2)="YES" I $P(GMTSREAC,U,3)["99VA8" Q 1
  1.  Q 1 ;STOP IF THERE IS ANY PROBLEMATIC DATA
  1.  ;----------------------------------------------------------