ONCGENED ;HINES OIFO/GWB - EDITS API ;10/19/11
;;2.2;ONCOLOGY;**1,4,6,10,13,16,17**;Jul 31, 2013;Build 6
;P10 V18 NAACCR / P16 WRONG EXTVER variable
;P17 V22 metafile
NAACCR D CLEAR^ONCSAPIE(1)
K ^TMP("ONC",$J)
K ^TMP("ONC1",$J)
N BLANK,DEVICE,DXH,EXT,IINPNT,MSGLST,NINE,OIEN,ONCEDLST,OSP
N PAGE,PAGEX,STAT1,ZERO,ZNINE
S ABSTAT=$$GET1^DIQ(165.5,D0,91,"I")
S:(ABSTAT=3)&($$GET1^DIQ(165.5,D0,282,"I")="N") $P(^ONCO(165.5,D0,"EDITS"),U,3)="U"
S:($$GET1^DIQ(165.5,D0,282,"I")="") $P(^ONCO(165.5,D0,"EDITS"),U,3)="N"
S BLANK=" "
S ZERO=0
S NINE=9
S ZNINE="09"
S EXTRACT=$O(^ONCO(160.16,"B","VACCR EXTRACT V22.0",0))
S EXT="VACCR"
S EXTVER=$G(^ONCO(160.16,EXTRACT,"FIELD",7,4))
S DEVICE=0,OIEN=0,PAGE=1,OUT=0
S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
I OSP="" S OSP=$O(^ONCO(160.1,0))
S IINPNT=$P($G(^ONCO(160.1,OSP,1)),U,4)
S DXH=$$GET1^DIQ(160.19,IINPNT,.01,"I")
S STAT1=DXH
S PAGE=1
S IEN=D0
S ONCDST=$NA(^TMP("ONC",$J))
S MSGLST=$NA(^TMP("ONC1",$J))
;
;S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST) ;comment for testing
S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST,"DEBUG") ;remove comment for testing
S ERRFLG=RC
I RC<0 D PRTERRS^ONCSAPIE() Q
;
N D0
D OUTPUT(IEN,EXTRACT,.OUT)
I $G(EDITS)="NO" D END^ONCSNACR(.ONCDST) Q
;
EDITS S RC=$$RBQEXEC^ONCSED01(.ONCSAPI,.ONCDST,MSGLST)
S ERRFLG=RC
I RC<0 D PRTERRS^ONCSAPIE()
I RC>0 D Q:RC<0
. N %ZIS,IOP,POP
. S %ZIS("B")="HOME"
. D ^%ZIS Q:$G(POP) U IO
. S RC=$$REPORT^ONCSED01(.ONCSAPI,MSGLST,"MT")
. D ^%ZISC
Q
;
OUTPUT(IEN,EXTRACT,OUT) ;
N POS
S ACD160=$P(^ONCO(165.5,IEN,0),U,2)
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))=""
..S STRING=$TR(^ONCO(160.16,EXTRACT,"FIELD",NODE,1),"~","^")
..S DEFAULT=^ONCO(160.16,EXTRACT,"FIELD",NODE,2)
..S FILL=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,3),U,1)
..S LEN=$P(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,2)
..D DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,NODE,POS)
Q
;
DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,NODE,POS) ;Data print
N ACDANS
S:'$D(ONCPHI) ONCPHI=0 ;P2.2*4
X STRING
I ACDANS="" D Q
.N X,I
.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)
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
;
CHKSUM ;Compute checksum
N CHECKSUM
Q:'$D(ONCDST)
Q:$P($G(^ONCO(165.5,D0,7)),U,2)'=3
W !," Computing checksum value for this abstract..."
S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
S $P(^ONCO(165.5,D0,"EDITS"),U,1)=CHECKSUM
S $P(^ONCO(165.5,D0,"EDITS"),U,2)=EXTVER
Q
;
CHANGE ;Check for change to ONCOLOGY PRIMARY (165.5) record
;first check if there are missing required fields.
;if there are and DTDX>3031231, set abstract status to incomplete - P54
N ONCFILE,DTDX,PRM
S ONCFILE=165.5,PRM=ONCOD0P
S DTDX=$P(^ONCO(165.5,PRM,0),U,16)
D F1655^ONCOEDC1
I $D(LIST),(DTDX>3031231),ABSTAT=3 D Q
.S ONCTYP="A" D PRINT^ONCOEDC
.S DIE="^ONCO(165.5,"
.S DA=ONCOD0P
.S DR="91///^S X=0" D ^DIE
.W !!,"ABSTRACT STATUS changed to 0 (Incomplete).",!
.K DIR S DIR(0)="E" D ^DIR
;
N ERRFLG
S EDITS="NO" D NAACCR K EDITS
S:'$D(CHECKSUM) CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
Q:$P($G(^ONCO(165.5,ONCOD0P,"EDITS")),U,1)=""
I (ABSTAT=3),(CHECKSUM'=$P($G(^ONCO(165.5,ONCOD0P,"EDITS")),U,1)) D
.W !
.W !," You have made a change to a 'Complete' abstract."
.W !," This abstract needs to be re-run through the EDITS API."
.W !!," Calling EDITS API..."
.S $P(^ONCO(165.5,ONCOD0P,"EDITS"),U,3)="U"
.S DIE="^ONCO(165.5,"
.S DA=ONCOD0P
.S DR="198///^S X=DT"
.D ^DIE
.D ^ONCGENED
.I ERRFLG'=0 D Q
..W !!," EDITS errors were encountered."
..W !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)."
..S DIE="^ONCO(165.5,"
..S DA=ONCOD0P
..S DR="91///0;197///@;199////^S X=DUZ"
..D ^DIE
..W !
..Q:$G(EAFLAG)="YES"
..K DIR S DIR(0)="YA"
..S DIR("A")=" Do you wish to return to the Primary Menu Options? "
..S DIR("B")="Yes" D ^DIR K DIR
..I Y=1 S Y="@0"
.W !!," No EDITS errors or warnings. ABSTRACT STATUS = 3 (Complete)."
.S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
.S DIE="^ONCO(165.5,"
.S DA=ONCOD0P
.S DR="197///^S X=CHECKSUM;197.1///^S X=EXTVER;199////^S X=DUZ"
.D ^DIE
.;S EDITS="NO" D NAACCR K EDITS
.;S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
.;S $P(^ONCO(165.5,D0,"EDITS"),U,1)=CHECKSUM
.;S $P(^ONCO(165.5,D0,"EDITS"),U,2)=EXTVER
.W !
.K DIR S DIR(0)="E" D ^DIR
K DA,DIE,DR,RC
Q
;
CLEANUP ;Cleanup
K EAFLAG,EXTVER,ONCDST,ONCOD0P,ONCSAPI,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCGENED 5117 printed Apr 09, 2024@21:25:03 Page 2
ONCGENED ;HINES OIFO/GWB - EDITS API ;10/19/11
+1 ;;2.2;ONCOLOGY;**1,4,6,10,13,16,17**;Jul 31, 2013;Build 6
+2 ;P10 V18 NAACCR / P16 WRONG EXTVER variable
+3 ;P17 V22 metafile
NAACCR DO CLEAR^ONCSAPIE(1)
+1 KILL ^TMP("ONC",$JOB)
+2 KILL ^TMP("ONC1",$JOB)
+3 NEW BLANK,DEVICE,DXH,EXT,IINPNT,MSGLST,NINE,OIEN,ONCEDLST,OSP
+4 NEW PAGE,PAGEX,STAT1,ZERO,ZNINE
+5 SET ABSTAT=$$GET1^DIQ(165.5,D0,91,"I")
+6 if (ABSTAT=3)&($$GET1^DIQ(165.5,D0,282,"I")="N")
SET $PIECE(^ONCO(165.5,D0,"EDITS"),U,3)="U"
+7 if ($$GET1^DIQ(165.5,D0,282,"I")="")
SET $PIECE(^ONCO(165.5,D0,"EDITS"),U,3)="N"
+8 SET BLANK=" "
+9 SET ZERO=0
+10 SET NINE=9
+11 SET ZNINE="09"
+12 SET EXTRACT=$ORDER(^ONCO(160.16,"B","VACCR EXTRACT V22.0",0))
+13 SET EXT="VACCR"
+14 SET EXTVER=$GET(^ONCO(160.16,EXTRACT,"FIELD",7,4))
+15 SET DEVICE=0
SET OIEN=0
SET PAGE=1
SET OUT=0
+16 SET OSP=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
+17 IF OSP=""
SET OSP=$ORDER(^ONCO(160.1,0))
+18 SET IINPNT=$PIECE($GET(^ONCO(160.1,OSP,1)),U,4)
+19 SET DXH=$$GET1^DIQ(160.19,IINPNT,.01,"I")
+20 SET STAT1=DXH
+21 SET PAGE=1
+22 SET IEN=D0
+23 SET ONCDST=$NAME(^TMP("ONC",$JOB))
+24 SET MSGLST=$NAME(^TMP("ONC1",$JOB))
+25 ;
+26 ;S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST) ;comment for testing
+27 ;remove comment for testing
SET RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST,"DEBUG")
+28 SET ERRFLG=RC
+29 IF RC<0
DO PRTERRS^ONCSAPIE()
QUIT
+30 ;
+31 NEW D0
+32 DO OUTPUT(IEN,EXTRACT,.OUT)
+33 IF $GET(EDITS)="NO"
DO END^ONCSNACR(.ONCDST)
QUIT
+34 ;
EDITS SET RC=$$RBQEXEC^ONCSED01(.ONCSAPI,.ONCDST,MSGLST)
+1 SET ERRFLG=RC
+2 IF RC<0
DO PRTERRS^ONCSAPIE()
+3 IF RC>0
Begin DoDot:1
+4 NEW %ZIS,IOP,POP
+5 SET %ZIS("B")="HOME"
+6 DO ^%ZIS
if $GET(POP)
QUIT
USE IO
+7 SET RC=$$REPORT^ONCSED01(.ONCSAPI,MSGLST,"MT")
+8 DO ^%ZISC
End DoDot:1
if RC<0
QUIT
+9 QUIT
+10 ;
OUTPUT(IEN,EXTRACT,OUT) ;
+1 NEW POS
+2 SET ACD160=$PIECE(^ONCO(165.5,IEN,0),U,2)
+3 SET POS=0
+4 FOR
SET POS=$ORDER(^ONCO(160.16,EXTRACT,"FIELD","B",POS))
if POS<1
QUIT
Begin DoDot:1
+5 NEW NODE
+6 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 SET STRING=$TRANSLATE(^ONCO(160.16,EXTRACT,"FIELD",NODE,1),"~","^")
+11 SET DEFAULT=^ONCO(160.16,EXTRACT,"FIELD",NODE,2)
+12 SET FILL=$PIECE(^ONCO(160.16,EXTRACT,"FIELD",NODE,3),U,1)
+13 SET LEN=$PIECE(^ONCO(160.16,EXTRACT,"FIELD",NODE,0),U,2)
+14 DO DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,NODE,POS)
End DoDot:2
if OUT
QUIT
End DoDot:1
if OUT
QUIT
+15 QUIT
+16 ;
DATA(IEN,ACD160,STRING,DEFAULT,FILL,LEN,NODE,POS) ;Data print
+1 NEW ACDANS
+2 ;P2.2*4
if '$DATA(ONCPHI)
SET ONCPHI=0
+3 XECUTE STRING
+4 IF ACDANS=""
Begin DoDot:1
+5 NEW X,I
+6 SET X=""
+7 IF DEFAULT=8
Begin DoDot:2
+8 FOR I=1:1:LEN
DO WRITE^ONCSNACR(.ONCDST,DEFAULT)
End DoDot:2
QUIT
+9 IF @DEFAULT="09"
DO WRITE^ONCSNACR(.ONCDST,@DEFAULT)
QUIT
+10 FOR I=1:1:LEN
DO WRITE^ONCSNACR(.ONCDST,@DEFAULT)
End DoDot:1
QUIT
+11 IF $LENGTH(ACDANS)=LEN
DO WRITE^ONCSNACR(.ONCDST,ACDANS)
QUIT
+12 IF $LENGTH(ACDANS)>LEN
DO WRITE^ONCSNACR(.ONCDST,$EXTRACT(ACDANS,1,LEN))
QUIT
+13 IF '$TEST
Begin DoDot:1
+14 NEW JUST,STUFF,I,REM,CAL
+15 SET JUST=$PIECE(FILL,",")
SET STUFF=$PIECE(FILL,",",2)
+16 SET REM=LEN-$LENGTH(ACDANS)
+17 IF JUST="R"
DO WRITE^ONCSNACR(.ONCDST,ACDANS)
+18 FOR I=1:1:REM
DO WRITE^ONCSNACR(.ONCDST,@STUFF)
+19 IF JUST="L"
DO WRITE^ONCSNACR(.ONCDST,ACDANS)
End DoDot:1
QUIT
+20 QUIT
+21 ;
CHKSUM ;Compute checksum
+1 NEW CHECKSUM
+2 if '$DATA(ONCDST)
QUIT
+3 if $PIECE($GET(^ONCO(165.5,D0,7)),U,2)'=3
QUIT
+4 WRITE !," Computing checksum value for this abstract..."
+5 SET CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
+6 SET $PIECE(^ONCO(165.5,D0,"EDITS"),U,1)=CHECKSUM
+7 SET $PIECE(^ONCO(165.5,D0,"EDITS"),U,2)=EXTVER
+8 QUIT
+9 ;
CHANGE ;Check for change to ONCOLOGY PRIMARY (165.5) record
+1 ;first check if there are missing required fields.
+2 ;if there are and DTDX>3031231, set abstract status to incomplete - P54
+3 NEW ONCFILE,DTDX,PRM
+4 SET ONCFILE=165.5
SET PRM=ONCOD0P
+5 SET DTDX=$PIECE(^ONCO(165.5,PRM,0),U,16)
+6 DO F1655^ONCOEDC1
+7 IF $DATA(LIST)
IF (DTDX>3031231)
IF ABSTAT=3
Begin DoDot:1
+8 SET ONCTYP="A"
DO PRINT^ONCOEDC
+9 SET DIE="^ONCO(165.5,"
+10 SET DA=ONCOD0P
+11 SET DR="91///^S X=0"
DO ^DIE
+12 WRITE !!,"ABSTRACT STATUS changed to 0 (Incomplete).",!
+13 KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+14 ;
+15 NEW ERRFLG
+16 SET EDITS="NO"
DO NAACCR
KILL EDITS
+17 if '$DATA(CHECKSUM)
SET CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
+18 if $PIECE($GET(^ONCO(165.5,ONCOD0P,"EDITS")),U,1)=""
QUIT
+19 IF (ABSTAT=3)
IF (CHECKSUM'=$PIECE($GET(^ONCO(165.5,ONCOD0P,"EDITS")),U,1))
Begin DoDot:1
+20 WRITE !
+21 WRITE !," You have made a change to a 'Complete' abstract."
+22 WRITE !," This abstract needs to be re-run through the EDITS API."
+23 WRITE !!," Calling EDITS API..."
+24 SET $PIECE(^ONCO(165.5,ONCOD0P,"EDITS"),U,3)="U"
+25 SET DIE="^ONCO(165.5,"
+26 SET DA=ONCOD0P
+27 SET DR="198///^S X=DT"
+28 DO ^DIE
+29 DO ^ONCGENED
+30 IF ERRFLG'=0
Begin DoDot:2
+31 WRITE !!," EDITS errors were encountered."
+32 WRITE !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)."
+33 SET DIE="^ONCO(165.5,"
+34 SET DA=ONCOD0P
+35 SET DR="91///0;197///@;199////^S X=DUZ"
+36 DO ^DIE
+37 WRITE !
+38 if $GET(EAFLAG)="YES"
QUIT
+39 KILL DIR
SET DIR(0)="YA"
+40 SET DIR("A")=" Do you wish to return to the Primary Menu Options? "
+41 SET DIR("B")="Yes"
DO ^DIR
KILL DIR
+42 IF Y=1
SET Y="@0"
End DoDot:2
QUIT
+43 WRITE !!," No EDITS errors or warnings. ABSTRACT STATUS = 3 (Complete)."
+44 SET CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
+45 SET DIE="^ONCO(165.5,"
+46 SET DA=ONCOD0P
+47 SET DR="197///^S X=CHECKSUM;197.1///^S X=EXTVER;199////^S X=DUZ"
+48 DO ^DIE
+49 ;S EDITS="NO" D NAACCR K EDITS
+50 ;S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
+51 ;S $P(^ONCO(165.5,D0,"EDITS"),U,1)=CHECKSUM
+52 ;S $P(^ONCO(165.5,D0,"EDITS"),U,2)=EXTVER
+53 WRITE !
+54 KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
+55 KILL DA,DIE,DR,RC
+56 QUIT
+57 ;
CLEANUP ;Cleanup
+1 KILL EAFLAG,EXTVER,ONCDST,ONCOD0P,ONCSAPI,Y
