- 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 Feb 18, 2025@23:55:13 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