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