ONCSRV01 ;HIRMFO/RVD-SERVER ROUTINE FOR 160.16 AND REPORTS ;6/12/13
;;2.2;ONCOLOGY;**1,4**;Jul 31, 2013;Build 5
;
16016 ;process if update, delete or new entry.
;* separates the mailman message
N ONC16016,ONCIEN
S ONC16016=$P(XMRGONC1,"*",3),ONCIEN=$P(XMRGONC1,"*",4)
I XMRGONC1["RULES" S IEN=0 G RULE ;update RULES.
I (XMRGONC1["DELETE")!(XMRGONC1["UPDATE") G DIK1 ;go to delete or update an entry.
S IEN=0
N DA,DR,ONC01,ONC1,ONC2,ONC3,ONCSS,ONCOLD,ONCRUDA
;
NUE ;new and update an entry in file #160.16
;#*^ seperate the message from the ien
S ONCSS=$G(ONCSRDAT(IEN)) G:'$D(ONCSS)!(ONCSS="") EXIT
S ONCOLD=$P(ONCSS,"#*^",1),ONCRUDA=$P(ONCSS,"#*^",2)
I ONCOLD=0 G UP160
I (ONCOLD=1),((IEN=2)!(IEN=3)) S ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,1)=^ONCO(160.16,ONC16016,"FIELD",ONCIEN,1)_ONCRUDA S IEN=IEN+1 G NUE
I ONCOLD=1 S ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,1)=ONCRUDA
I ONCOLD=2 S ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,2)=ONCRUDA
I ONCOLD=3 S ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,3)=ONCRUDA
I ONCOLD=4 S ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,4)=ONCRUDA
S IEN=IEN+1
G NUE
;
UP160 ;add/update an entry in the extract.
S DIC(0)="EL"
S DA(1)=ONC16016,DA=ONCIEN
S ONC01=$P(ONCSS,U,2),ONC1=$P(ONCSS,U,3),ONC2=$P(ONCSS,U,4),ONC3=$P(ONCSS,U,5)
S DIE="^ONCO(160.16,"_DA(1)_",""FIELD"","
S DR=".01///^S X=ONC01;1///^S X=ONC1;2///^S X=ONC2;3///^S X=ONC3" D ^DIE
S IEN=IEN+1
G NUE
;
DIK1 ;delete an entry in file #160.16
N DIK,DA
S DA(1)=ONC16016,DA=ONCIEN
S DIK="^ONCO(160.16,"_DA(1)_",""FIELD""," D ^DIK
G NUE
;
RULE ;update RULES node
;#*^ seperate the message from ien
;K ^ONCO(150.16,ONC15016,"RULES") ;clean-up before updating, remove comment when release
N ONCSS,ONCOLD,ONCRUDA
S ONCSS=$G(ONCSRDAT(IEN)),ONCOLD=$P(ONCSS,"#*^",1),ONCRUDA=$P(ONCSS,"#*^",2)
S ^ONCO(160.16,ONC16016,"RULES",ONCOLD)=ONCRUDA
RULES ;
S IEN=IEN+1
S ONCSS=$G(ONCSRDAT(IEN)) G:'$D(ONCSS)!(ONCSS="") EXIT
S ONCOLD=$P(ONCSS,"#*^",1),ONCRUDA=$P(ONCSS,"#*^",2)
I $D(^ONCO(160.16,ONC16016,"RULES",ONCOLD,0)) S ^ONCO(160.16,ONC16016,"RULES",ONCOLD,0)=^ONCO(160.16,ONC16016,"RULES",ONCOLD,0)_ONCRUDA G RULES
S ^ONCO(160.16,ONC16016,"RULES",ONCOLD,0)=ONCRUDA
G RULES
;
1655 ;update or add a new DD in Oncology Primary file, for future use.
Q
EXIT ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSRV01 2323 printed Dec 13, 2024@02:28:45 Page 2
ONCSRV01 ;HIRMFO/RVD-SERVER ROUTINE FOR 160.16 AND REPORTS ;6/12/13
+1 ;;2.2;ONCOLOGY;**1,4**;Jul 31, 2013;Build 5
+2 ;
16016 ;process if update, delete or new entry.
+1 ;* separates the mailman message
+2 NEW ONC16016,ONCIEN
+3 SET ONC16016=$PIECE(XMRGONC1,"*",3)
SET ONCIEN=$PIECE(XMRGONC1,"*",4)
+4 ;update RULES.
IF XMRGONC1["RULES"
SET IEN=0
GOTO RULE
+5 ;go to delete or update an entry.
IF (XMRGONC1["DELETE")!(XMRGONC1["UPDATE")
GOTO DIK1
+6 SET IEN=0
+7 NEW DA,DR,ONC01,ONC1,ONC2,ONC3,ONCSS,ONCOLD,ONCRUDA
+8 ;
NUE ;new and update an entry in file #160.16
+1 ;#*^ seperate the message from the ien
+2 SET ONCSS=$GET(ONCSRDAT(IEN))
if '$DATA(ONCSS)!(ONCSS="")
GOTO EXIT
+3 SET ONCOLD=$PIECE(ONCSS,"#*^",1)
SET ONCRUDA=$PIECE(ONCSS,"#*^",2)
+4 IF ONCOLD=0
GOTO UP160
+5 IF (ONCOLD=1)
IF ((IEN=2)!(IEN=3))
SET ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,1)=^ONCO(160.16,ONC16016,"FIELD",ONCIEN,1)_ONCRUDA
SET IEN=IEN+1
GOTO NUE
+6 IF ONCOLD=1
SET ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,1)=ONCRUDA
+7 IF ONCOLD=2
SET ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,2)=ONCRUDA
+8 IF ONCOLD=3
SET ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,3)=ONCRUDA
+9 IF ONCOLD=4
SET ^ONCO(160.16,ONC16016,"FIELD",ONCIEN,4)=ONCRUDA
+10 SET IEN=IEN+1
+11 GOTO NUE
+12 ;
UP160 ;add/update an entry in the extract.
+1 SET DIC(0)="EL"
+2 SET DA(1)=ONC16016
SET DA=ONCIEN
+3 SET ONC01=$PIECE(ONCSS,U,2)
SET ONC1=$PIECE(ONCSS,U,3)
SET ONC2=$PIECE(ONCSS,U,4)
SET ONC3=$PIECE(ONCSS,U,5)
+4 SET DIE="^ONCO(160.16,"_DA(1)_",""FIELD"","
+5 SET DR=".01///^S X=ONC01;1///^S X=ONC1;2///^S X=ONC2;3///^S X=ONC3"
DO ^DIE
+6 SET IEN=IEN+1
+7 GOTO NUE
+8 ;
DIK1 ;delete an entry in file #160.16
+1 NEW DIK,DA
+2 SET DA(1)=ONC16016
SET DA=ONCIEN
+3 SET DIK="^ONCO(160.16,"_DA(1)_",""FIELD"","
DO ^DIK
+4 GOTO NUE
+5 ;
RULE ;update RULES node
+1 ;#*^ seperate the message from ien
+2 ;K ^ONCO(150.16,ONC15016,"RULES") ;clean-up before updating, remove comment when release
+3 NEW ONCSS,ONCOLD,ONCRUDA
+4 SET ONCSS=$GET(ONCSRDAT(IEN))
SET ONCOLD=$PIECE(ONCSS,"#*^",1)
SET ONCRUDA=$PIECE(ONCSS,"#*^",2)
+5 SET ^ONCO(160.16,ONC16016,"RULES",ONCOLD)=ONCRUDA
RULES ;
+1 SET IEN=IEN+1
+2 SET ONCSS=$GET(ONCSRDAT(IEN))
if '$DATA(ONCSS)!(ONCSS="")
GOTO EXIT
+3 SET ONCOLD=$PIECE(ONCSS,"#*^",1)
SET ONCRUDA=$PIECE(ONCSS,"#*^",2)
+4 IF $DATA(^ONCO(160.16,ONC16016,"RULES",ONCOLD,0))
SET ^ONCO(160.16,ONC16016,"RULES",ONCOLD,0)=^ONCO(160.16,ONC16016,"RULES",ONCOLD,0)_ONCRUDA
GOTO RULES
+5 SET ^ONCO(160.16,ONC16016,"RULES",ONCOLD,0)=ONCRUDA
+6 GOTO RULES
+7 ;
1655 ;update or add a new DD in Oncology Primary file, for future use.
+1 QUIT
EXIT ;
+1 QUIT
