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

HDISDSR.m

Go to the documentation of this file. 
  1. HDISDSR ;BPFO/DTG - HDI MAILMAN SERVER FOR COLLECTING SDO; Apr 07, 2018@12:42
  1.  ;;1.0;HEALTH DATA & INFORMATICS;**22**;Feb 22, 2005;Build 26
  1.  ;
  1. START ;
  1.  N A,HDISITE,HDIST,HDISUB,HDIXMZ,HDISV,HDER,HDICRLF,HDIJB,HDILEN,HDIMSUBJ,HDIQUIT,HDITXT,HDINODE
  1.  N HDIMAX
  1.  ;
  1.  ; Save incoming server message id for cleanup
  1.  S HDIXMZ=XMZ
  1.  ;
  1.  S HDISV="^TMP($J,""HDIDATA"")",HDER="^TMP($J,""HDIDTERR"")"
  1.  K @HDISV,@HDER
  1.  ; Determine station name and number
  1.  S HDISITE=$$SITE^VASITE,HDISTN=$P(HDISITE,"^",2),HDIST=$P(HDISITE,"^",3)
  1.  I HDIST="" S HDIST="???"
  1.  ;
  1.  S HDISUB=$$UP^XLFSTR(XQSUB)
  1.  ;
  1.  ; The first line of the message tells who requested the action and when
  1.  ; The second line tells when the server is activated and no data can be
  1.  ; gathered from the MailMan message.  This line gets replaced if the
  1.  ; server finds something to do.
  1.  S A="SDO lookup option: "_HDISUB_$J("      ",6)
  1.  S ^TMP($J,"HDIDATA",1)=A
  1.  S A="Was triggered at "_HDISTN_" by "_XMFROM_" on "_XQDATE_$J("      ",6)
  1.  S ^TMP($J,"HDIDATA",2)=A
  1.  S ^TMP($J,"HDIDATA",3)=" "_$J("      ",6)
  1.  S HDIACTON=HDISUB
  1.  S A="This SDO lookup option: "_HDIACTON_$J("      ",6)
  1.  S ^TMP($J,"HDIDATA",4)=A
  1.  S A="Is NOT available at "_HDISTN_$J("      ",6)
  1.  S ^TMP($J,"HDIDATA",5)=A
  1.  S A=""
  1.  ;
  1.  ;
  1.  I HDISUB="LAB" D EN1^HDISDSRL Q
  1.  ;
  1.  ; If subject not understood by server, send a message to the sender
  1.  ;  that the server can't understand their instructions.
  1.  K XMY
  1.  S XMY(XQSND)=""
  1.  ;
  1. EXIT ; If all went well, report that too.
  1.  ; Mail the errors and successes back to the Roll-Up group at Forum.
  1.  N HDINOW
  1.  S HDINOW=$$NOW^XLFDT,A=$$FMTE^XLFDT(HDINOW,5)
  1.  S XMDUN="HDI SDO Server",XMDUZ=".5",XMSUB=HDISTN_" HDI SDO SERVER ("_A_" ["_HDINOW_"])"
  1.  K XMTEXT S XMTEXT="^TMP($J,""HDIDATA"","
  1.  I '$D(XMY) S XMY($G(XQSND))=""
  1.  N DIFROM D ^XMD K DIFROM
  1.  ;
  1. CLEAN ; Cleanup and exit
  1.  I $D(^TMP($J,"HDIDTERR")) D
  1.  . S XMDUN="HDI SDO Order Server",XMDUZ=".5"
  1.  . S XMSUB=HDISTN_" HDI SDO ORDER SERVER ERROR ("_HDINOW_")"
  1.  . S XMTEXT="^TMP($J,""HDIDTERR"","
  1.  . S XMY(XQSND)=""
  1.  . D ^XMD
  1.  ;
  1.  ; Clean up server message in MailMan
  1.  I $G(HDIXMZ)>0 D ZAPSERV^XMXAPI("S.HDISDOSERVER",HDIXMZ)
  1.  ;
  1.  K %,%DT,%H,D,DD,DIC,DIERR,ERROR,FILL,LINE,LOINCDTA,LOINCDTB,LOINCTAS
  1.  K HDIA,HDIAA,HDIACTON,HDIB,HDICLST,HDIDA,HDIERR,HDIFOUND,HDIFOUND1,HDII,HDILINE
  1.  K HDINDE,HDIOUT,HDIPNT,HDIPNTA,HDIPNTB,HDIRDT,HDIRN,HDIROOT,HDIST,HDISTN,HDISUB
  1.  K X,XMDUN,XMDUZ,XMER,XMFROM,XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,HDINODE
  1.  K XQSND,XQSUB,Y,ZTQUEUED,ZTSK,HDICRLF,HDIJB,HDILEN,HDIMSUBJ,HDIQUIT,HDITXT
  1.  K HDIMAX
  1.  ;
  1.  K ^TMP($J,"HDIDATA"),^TMP($J,"HDIDTERR")
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q