- 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 Jan 18, 2025@03:29:54 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