- ONCRPC ;Hines OIFO/GWB - Extract VACCR data via ONC VACCR RPC ;09/22/11
- ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- ;;
- EN1(RESULT,DATEUSED,START,END) ;Entry point
- K ^TMP("ONCRPC")
- N VERSION
- S VERSION=$O(^ONCO(160.16,"B","VACCR EXTRACT"))
- S EXTRACT=$O(^ONCO(160.16,"B",VERSION,0))
- S OUT=0
- S U="^"
- D SETUP
- S RESULT=$NA(^TMP("ONCRPC"))
- Q
- ;
- SETUP ;Loop through appropriate cross-reference
- N BLANK,DCLC,FDNUM,IEN,NC,NINE,TPG,ZERO,ZNINE,X
- N DIVISION,FACPNT,ONCDST,ONCSAPI,OSPIEN,RC,RESULT,STAT1
- S BLANK=" "
- S (IEN,ZERO)=0
- S NINE=9,ZNINE="09"
- ;
- ;VACCR/STATE EXTRACT
- ;Loop through DATE CASE COMPLETED (165.5,90) "AAD" cross-reference
- I DATEUSED=1 S START=START-1 F S START=$O(^ONCO(165.5,"AAD",START)) Q:(START<1)!(START>END) F S IEN=$O(^ONCO(165.5,"AAD",START,IEN)) Q:IEN<1 D
- .Q:$G(^ONCO(165.5,IEN,0))=""
- .D LOOP
- ;
- ;VACCR/STATE EXTRACT
- ;Loop through DATE CASE LAST CHANGED (165.5,198) "AAE" cross-reference
- I DATEUSED=2 S START=START-1 F S START=$O(^ONCO(165.5,"AAE",START)) Q:(START<1)!(START>END) F S IEN=$O(^ONCO(165.5,"AAE",START,IEN)) Q:IEN<1 D
- .Q:$G(^ONCO(165.5,IEN,0))=""
- .D LOOP
- ;
- Q
- ;
- LOOP ;Apply extract selection rules
- N LINE,RULES,VALID,JUMP
- S RULES=0
- F S RULES=$O(^ONCO(160.16,EXTRACT,"RULES",RULES)) Q:RULES<1 D
- .S LINE=^ONCO(160.16,EXTRACT,"RULES",RULES,0)
- .X LINE
- Q:'VALID
- S DIVISION=$P($G(^ONCO(165.5,IEN,"DIV")),U,1)
- Q:DIVISION=""
- S OSPIEN=$O(^ONCO(160.1,"C",DIVISION,0))
- Q:OSPIEN=""
- S FACPNT=$P($G(^ONCO(160.1,OSPIEN,1)),U,4)
- Q:FACPNT=""
- S STAT1=$P($G(^ONCO(160.19,FACPNT,0)),U,1)
- S:$P(^ONCO(165.5,IEN,24),U,25)="" $P(^ONCO(165.5,IEN,24),U,25)=DT
- D OUTPUT(IEN,EXTRACT,JUMP,.OUT)
- D END^ONCSNACR(.ONCDST)
- D TRAILER^ONCSAPIR(.ONCDST)
- Q
- ;
- OUTPUT(IEN,EXTRACT,JUMP,OUT) ;Output
- S ONCDST=$NA(^TMP("ONCRPC",IEN))
- S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST)
- S ACD160=$P(^ONCO(165.5,IEN,0),U,2)
- N POS S POS=0
- F S POS=$O(^ONCO(160.16,EXTRACT,"FIELD","B",POS)) Q:POS<1 D Q:OUT
- .N NODE S NODE=0
- .F S NODE=$O(^ONCO(160.16,EXTRACT,"FIELD","B",POS,NODE)) Q:NODE<1 D Q:OUT
- ..N STRING,DEFAULT,FILL,LEN
- ..Q:$G(^ONCO(160.16,EXTRACT,"FIELD",NODE,0))=""
- ..;D DISPLAY(DEVICE,$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,1)_U_$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,4),.OUT)
- ..S LEN=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,2)
- ..S STRING=$TR(^ONCO(160.16,EXTRACT,"FIELD",NODE,1),"~","^")
- ..S DEFAULT=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,2),U,1)
- ..S FILL=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,3),U,1)
- ..D DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS)
- Q
- ;
- DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS) ;Compute extract value
- N ACDANS,EXIT S EXIT=0
- I JUMP'="0" D
- .I POS<$P(JUMP,U) Q
- .I POS>$P(JUMP,U,2) Q
- .N I
- .S EXIT=1
- .F I=1:1:LEN W BLANK
- Q:EXIT
- X STRING
- ;
- ;If value = "", extract DEFAULT value
- I ACDANS="" D Q
- .N I,X S X=""
- .I DEFAULT=8 D Q
- ..F I=1:1:LEN D WRITE^ONCSNACR(.ONCDST,DEFAULT)
- .I @DEFAULT="09" D WRITE^ONCSNACR(.ONCDST,@DEFAULT) Q
- .F I=1:1:LEN D WRITE^ONCSNACR(.ONCDST,@DEFAULT)
- ;
- ;If value too long, truncate to LENGTH (160.161,1)
- ;If value too short, pad with FILL (160.161,6)
- I $L(ACDANS)=LEN D WRITE^ONCSNACR(.ONCDST,ACDANS) Q
- I $L(ACDANS)>LEN D WRITE^ONCSNACR(.ONCDST,$E(ACDANS,1,LEN)) Q
- E D Q
- .N JUST,STUFF,I,REM,CAL
- .S JUST=$P(FILL,","),STUFF=$P(FILL,",",2)
- .S REM=LEN-$L(ACDANS)
- .I JUST="R" D WRITE^ONCSNACR(.ONCDST,ACDANS)
- .F I=1:1:REM D WRITE^ONCSNACR(.ONCDST,@STUFF)
- .I JUST="L" D WRITE^ONCSNACR(.ONCDST,ACDANS)
- Q
- ;
- CLEANUP ;Cleanup
- K DATEUSED,END,START
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCRPC 3604 printed Feb 18, 2025@23:54:10 Page 2
- ONCRPC ;Hines OIFO/GWB - Extract VACCR data via ONC VACCR RPC ;09/22/11
- +1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- +2 ;;
- EN1(RESULT,DATEUSED,START,END) ;Entry point
- +1 KILL ^TMP("ONCRPC")
- +2 NEW VERSION
- +3 SET VERSION=$ORDER(^ONCO(160.16,"B","VACCR EXTRACT"))
- +4 SET EXTRACT=$ORDER(^ONCO(160.16,"B",VERSION,0))
- +5 SET OUT=0
- +6 SET U="^"
- +7 DO SETUP
- +8 SET RESULT=$NAME(^TMP("ONCRPC"))
- +9 QUIT
- +10 ;
- SETUP ;Loop through appropriate cross-reference
- +1 NEW BLANK,DCLC,FDNUM,IEN,NC,NINE,TPG,ZERO,ZNINE,X
- +2 NEW DIVISION,FACPNT,ONCDST,ONCSAPI,OSPIEN,RC,RESULT,STAT1
- +3 SET BLANK=" "
- +4 SET (IEN,ZERO)=0
- +5 SET NINE=9
- SET ZNINE="09"
- +6 ;
- +7 ;VACCR/STATE EXTRACT
- +8 ;Loop through DATE CASE COMPLETED (165.5,90) "AAD" cross-reference
- +9 IF DATEUSED=1
- SET START=START-1
- FOR
- SET START=$ORDER(^ONCO(165.5,"AAD",START))
- if (START<1)!(START>END)
- QUIT
- FOR
- SET IEN=$ORDER(^ONCO(165.5,"AAD",START,IEN))
- if IEN<1
- QUIT
- Begin DoDot:1
- +10 if $GET(^ONCO(165.5,IEN,0))=""
- QUIT
- +11 DO LOOP
- End DoDot:1
- +12 ;
- +13 ;VACCR/STATE EXTRACT
- +14 ;Loop through DATE CASE LAST CHANGED (165.5,198) "AAE" cross-reference
- +15 IF DATEUSED=2
- SET START=START-1
- FOR
- SET START=$ORDER(^ONCO(165.5,"AAE",START))
- if (START<1)!(START>END)
- QUIT
- FOR
- SET IEN=$ORDER(^ONCO(165.5,"AAE",START,IEN))
- if IEN<1
- QUIT
- Begin DoDot:1
- +16 if $GET(^ONCO(165.5,IEN,0))=""
- QUIT
- +17 DO LOOP
- End DoDot:1
- +18 ;
- +19 QUIT
- +20 ;
- LOOP ;Apply extract selection rules
- +1 NEW LINE,RULES,VALID,JUMP
- +2 SET RULES=0
- +3 FOR
- SET RULES=$ORDER(^ONCO(160.16,EXTRACT,"RULES",RULES))
- if RULES<1
- QUIT
- Begin DoDot:1
- +4 SET LINE=^ONCO(160.16,EXTRACT,"RULES",RULES,0)
- +5 XECUTE LINE
- End DoDot:1
- +6 if 'VALID
- QUIT
- +7 SET DIVISION=$PIECE($GET(^ONCO(165.5,IEN,"DIV")),U,1)
- +8 if DIVISION=""
- QUIT
- +9 SET OSPIEN=$ORDER(^ONCO(160.1,"C",DIVISION,0))
- +10 if OSPIEN=""
- QUIT
- +11 SET FACPNT=$PIECE($GET(^ONCO(160.1,OSPIEN,1)),U,4)
- +12 if FACPNT=""
- QUIT
- +13 SET STAT1=$PIECE($GET(^ONCO(160.19,FACPNT,0)),U,1)
- +14 if $PIECE(^ONCO(165.5,IEN,24),U,25)=""
- SET $PIECE(^ONCO(165.5,IEN,24),U,25)=DT
- +15 DO OUTPUT(IEN,EXTRACT,JUMP,.OUT)
- +16 DO END^ONCSNACR(.ONCDST)
- +17 DO TRAILER^ONCSAPIR(.ONCDST)
- +18 QUIT
- +19 ;
- OUTPUT(IEN,EXTRACT,JUMP,OUT) ;Output
- +1 SET ONCDST=$NAME(^TMP("ONCRPC",IEN))
- +2 SET RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST)
- +3 SET ACD160=$PIECE(^ONCO(165.5,IEN,0),U,2)
- +4 NEW POS
- SET POS=0
- +5 FOR
- SET POS=$ORDER(^ONCO(160.16,EXTRACT,"FIELD","B",POS))
- if POS<1
- QUIT
- Begin DoDot:1
- +6 NEW NODE
- SET NODE=0
- +7 FOR
- SET NODE=$ORDER(^ONCO(160.16,EXTRACT,"FIELD","B",POS,NODE))
- if NODE<1
- QUIT
- Begin DoDot:2
- +8 NEW STRING,DEFAULT,FILL,LEN
- +9 if $GET(^ONCO(160.16,EXTRACT,"FIELD",NODE,0))=""
- QUIT
- +10 ;D DISPLAY(DEVICE,$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,1)_U_$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,4),.OUT)
- +11 SET LEN=$PIECE(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,2)
- +12 SET STRING=$TRANSLATE(^ONCO(160.16,EXTRACT,"FIELD",NODE,1),"~","^")
- +13 SET DEFAULT=$PIECE(^ONCO(160.16,EXTRACT,"FIELD",NODE,2),U,1)
- +14 SET FILL=$PIECE(^ONCO(160.16,EXTRACT,"FIELD",NODE,3),U,1)
- +15 DO DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS)
- End DoDot:2
- if OUT
- QUIT
- End DoDot:1
- if OUT
- QUIT
- +16 QUIT
- +17 ;
- DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,JUMP,NODE,POS) ;Compute extract value
- +1 NEW ACDANS,EXIT
- SET EXIT=0
- +2 IF JUMP'="0"
- Begin DoDot:1
- +3 IF POS<$PIECE(JUMP,U)
- QUIT
- +4 IF POS>$PIECE(JUMP,U,2)
- QUIT
- +5 NEW I
- +6 SET EXIT=1
- +7 FOR I=1:1:LEN
- WRITE BLANK
- End DoDot:1
- +8 if EXIT
- QUIT
- +9 XECUTE STRING
- +10 ;
- +11 ;If value = "", extract DEFAULT value
- +12 IF ACDANS=""
- Begin DoDot:1
- +13 NEW I,X
- SET X=""
- +14 IF DEFAULT=8
- Begin DoDot:2
- +15 FOR I=1:1:LEN
- DO WRITE^ONCSNACR(.ONCDST,DEFAULT)
- End DoDot:2
- QUIT
- +16 IF @DEFAULT="09"
- DO WRITE^ONCSNACR(.ONCDST,@DEFAULT)
- QUIT
- +17 FOR I=1:1:LEN
- DO WRITE^ONCSNACR(.ONCDST,@DEFAULT)
- End DoDot:1
- QUIT
- +18 ;
- +19 ;If value too long, truncate to LENGTH (160.161,1)
- +20 ;If value too short, pad with FILL (160.161,6)
- +21 IF $LENGTH(ACDANS)=LEN
- DO WRITE^ONCSNACR(.ONCDST,ACDANS)
- QUIT
- +22 IF $LENGTH(ACDANS)>LEN
- DO WRITE^ONCSNACR(.ONCDST,$EXTRACT(ACDANS,1,LEN))
- QUIT
- +23 IF '$TEST
- Begin DoDot:1
- +24 NEW JUST,STUFF,I,REM,CAL
- +25 SET JUST=$PIECE(FILL,",")
- SET STUFF=$PIECE(FILL,",",2)
- +26 SET REM=LEN-$LENGTH(ACDANS)
- +27 IF JUST="R"
- DO WRITE^ONCSNACR(.ONCDST,ACDANS)
- +28 FOR I=1:1:REM
- DO WRITE^ONCSNACR(.ONCDST,@STUFF)
- +29 IF JUST="L"
- DO WRITE^ONCSNACR(.ONCDST,ACDANS)
- End DoDot:1
- QUIT
- +30 QUIT
- +31 ;
- CLEANUP ;Cleanup
- +1 KILL DATEUSED,END,START
