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

ONCSRV.m

Go to the documentation of this file.
  1. ONCSRV ;Hines OIFO/RVD - SERVER ROUTINE FOR ONCOLOGY ; 5/10/2013
  1. ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;DBIA # 10072 - for routine REMSBMSG^XMA1C
  1. ;
  1. N ONCDS1,ONCDS2,ONCDT1,ONCDT2,ONCIIA,ONCSRDAT,XMRGONC1,ONCMSG,ONCUSS,ONCUSSNA,ONC0I,ONC0J
  1. D NOW^%DTC
  1. ;
  1. X XMREC S XMRGONC1=XMRG
  1. S ONCIIA=0
  1. XMR ;
  1. X XMREC
  1. S ONCSRDAT(ONCIIA)=XMRG
  1. S ONCIIA=ONCIIA+1
  1. I (XMRG="END")!(XMRG="") G SNDC
  1. G XMR
  1. ;
  1. SNDC ;Send confirmation message to Mail Server Recipient in file #160.1
  1. S XMDUZ=.5
  1. D REC ;get recipient from site parameter.
  1. S XMSUB="Oncology Server Activation for "_$P($$SITE^VASITE,U,2)
  1. S ONCMSG(1)="The Oncology Server was activated today by the Oncology Office. "
  1. S ONCMSG(2)="Please note if data was processed correctly..."
  1. S ONCMSG(3)=""
  1. s ONCMSG(4)="Server message is: "_XMRGONC1
  1. S ONCMSG(5)=""
  1. S ONCMSG(6)="This was activated by "_$P(XMFROM,"@",1)
  1. S ONCMSG(7)=""
  1. S XMTEXT="ONCMSG("
  1. D ^XMD
  1. K XMTEXT,ONCMSG
  1. USS ;check if valid mail server user
  1. S ONCUSS=0
  1. F ONC0I=0:0 S ONC0I=$O(^ONCO(160.1,ONC0I)) Q:ONC0I'>0 D
  1. .F ONC0J=0:0 S ONC0J=$O(^ONCO(160.1,ONC0I,"SEU",ONC0J)) Q:ONC0J'>0 D
  1. ..S ONCUSSNA=$P($G(^ONCO(160.1,ONC0I,"SEU",ONC0J,0)),U,1)
  1. ..S:XMFROM[ONCUSSNA ONCUSS=1
  1. I ONCUSS=0 G INV ;invalid mail server user.
  1. ;
  1. PROC ;process the content of the message
  1. N ONCRC
  1. ;update server address
  1. ;production server- S XMRGONC1="SERVER*http://127.0.0.1:1757/cgi_bin/oncsrv.exe"
  1. I $P(XMRGONC1,"*",1)="SERVER" S ONCRC=$$UPDCSURL^ONCSAPIU($P(XMRGONC1,"*",2)) G EXIT
  1. ;timeliness report
  1. ;example of the message
  1. ;TIMELINESS*/1/1/2010*12/31/1012*YES*YES
  1. I XMRGONC1["TIMELINESS" G ^ONCSRVTM
  1. ;update file 160.16, example below
  1. ;it be NEW, UPDATE, DELETE or RULES.
  1. ;160.16*UPDATE*1*2555 where: 1=ien of 160,16( can be 1, 2 or 3), 2555 = field
  1. ;0#*^contains of node 0
  1. ;1#*^contains of node 1
  1. ;2#*^contains of node 2
  1. ;3#*^
  1. I $P(XMRGONC1,"*",1)=160.16 G 16016^ONCSRV01
  1. ;process Registry report for Today
  1. ;example REGISTRY*TODAY
  1. I XMRGONC1["REGISTRY" G ^ONCSRVRP
  1. I $P(XMRGONC1,"*",1)="MAIL SERVER" D MSE ;update mail server user and recipient
  1. ;update file 165.5 for future patch
  1. ;I $P(XMRGONC1,"*",1)=165.5 G 1655^ONCSRV01
  1. G EXIT
  1. ;
  1. MSE ;update mail server
  1. ;MAIL SERVER*VALID USER*RECIPIENT mail address
  1. ;MAIL SERVER*USER1*test.user@domain.ext
  1. N ONCMSRE,ONCMSUS,DIC,DA,DR,DIE,Y
  1. S IEN=0,DIC(0)="L"
  1. F S IEN=$O(^ONCO(160.1,IEN)) Q:IEN'>0 D
  1. .S DA(1)=IEN,(DIE,DIC)="^ONCO(160.1,DA(1),""SEU"","
  1. .S ONCMSRE=$P(XMRGONC1,"*",3),ONCMSUS=$P(XMRGONC1,"*",2)
  1. .I '$D(^ONCO(160.1,IEN,"SEU","B",ONCMSUS)) D
  1. ..S DIC("DR")="2///^S X=ONCMSRE",X=ONCMSUS D FILE^DICN
  1. .I $D(^ONCO(160.1,IEN,"SEU","B",ONCMSUS)) D
  1. ..S DA=$O(^ONCO(160.1,IEN,"SEU","B",ONCMSUS,0))
  1. ..S DR="2///^S X=ONCMSRE" D ^DIE
  1. Q
  1. ;
  1. REC ;get mail recipient
  1. F ONC0I=0:0 S ONC0I=$O(^ONCO(160.1,ONC0I)) Q:ONC0I'>0 D
  1. .F ONC0J=0:0 S ONC0J=$O(^ONCO(160.1,ONC0I,"SEU",ONC0J)) Q:ONC0J'>0 D
  1. ..S ONCUSSNA=$P($G(^ONCO(160.1,ONC0I,"SEU",ONC0J,0)),U,2)
  1. ..S XMY(ONCUSSNA)=""
  1. Q
  1. ;add additional extract here if needed
  1. ;D EXT^ONCSRV02
  1. ;
  1. INV ;message due to invalid user
  1. S XMDUZ=.5
  1. D REC ;get recipients from site parameter file
  1. S XMSUB="Oncology Invalid User Activation for "_$P($$SITE^VASITE,U,2)
  1. S ONCMSG(1)="The Oncology Server was activated today by an invalid user. "
  1. S ONCMSG(2)=""
  1. S ONCMSG(3)="This was activated by "_XMFROM
  1. S XMTEXT="ONCMSG("
  1. D ^XMD
  1. K XMTEXT,ONCMSG
  1. ;
  1. EXIT ;common exit point
  1. S XMSER="S."_XQSOP,XMZ=XQMSG D REMSBMSG^XMA1C
  1. K ONCDAT1,ONCDAT2,ONCDT1,XMRG,XMSUB,ONCRC
  1. K ONCDET,ONCDOR1,ONCDORS,ONCDORW,ONCDS1,ONCDS2,ONCDT2,ONCMSG
  1. K ONCPIP1,ONCPIP2,XMDUZ,XMFROM,XMREC,XMSER,XMTEXT,XMY,XMZ,XQMSG,XQSOP,Y
  1. Q
  1. ;END