ONCGENED ;HINES OIFO/GWB - EDITS API ;10/19/11
;;2.2;ONCOLOGY;**1,4,6,10,13,16,17,19,20**;Jul 31, 2013;Build 5
;P10 V18 NAACCR / P16 WRONG EXTVER variable
;P17 V22 metafile, P20 V23 metafile
;P19 Edits of XML DATA to DC Cloud Web Service
NAACCR D CLEAR^ONCSAPIE(1)
K ^TMP("ONC",$J)
K ^TMP("ONC1",$J)
N BLANK,DEVICE,DXH,EXT,IINPNT,MSGLST,NINE,OIEN,ONCEDLST,OSP,ACD160
N PAGE,PAGEX,STAT1,ZERO,ZNINE,ONCCSID,ONCCSTP,ONCREID,ONCDTTIM
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 ACD160=$$GET1^DIQ(165.5,D0,.02,"I")
D PID^ONCOCOP S ONCCSID=X
;S ONCREID=$$ICN^ONCACDU2(ACD160)
S ONCREID=D0
S ONCCSTP=$$GET1^DIQ(165.5,D0,282,"I")
S BLANK=" "
S ZERO=0
S NINE=9
S ZNINE="09"
S EXTRACT=$O(^ONCO(160.16,"B","VACCR EXTRACT V23.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))
;P19
D XMLHDR^ONCSED01 ;build XML request header
D XMLEDIT^ONCSED01 ;build XML request message body
K ^TMP("ONCSED01R",$J) ;clear the response ^TMP global
S ONCEXEC="P" D T3^ONCWEB1 ;send request to cloud server
S ERRFLG=0 D PARSE^ONCWEBP1 ;new code parse rspns from cloud server
I ERRFLG=2 W !,"XML/server problem" Q ;error in server call
I ERRFLG=1 D DISPLAY^ONCWEBP1 Q ;display EDITs errors from server
I ERRFLG=0 Q ;case complete
;
;S RC=$$PARSE^ONCSED02(.ONCSAPI,ONC8RDAT,ONC8MSG) ;this is part of P19 testing
;S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST) ;comment for testing
;S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST,"DEBUG") ;comment for cloud server
;S ERRFLG=RC ; comment out for Patch 19
;I RC<0 D PRTERRS^ONCSAPIE() Q ; comment out for Patch 19
;
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 6094 printed Dec 13, 2024@02:22:55 Page 2
ONCGENED ;HINES OIFO/GWB - EDITS API ;10/19/11
+1 ;;2.2;ONCOLOGY;**1,4,6,10,13,16,17,19,20**;Jul 31, 2013;Build 5
+2 ;P10 V18 NAACCR / P16 WRONG EXTVER variable
+3 ;P17 V22 metafile, P20 V23 metafile
+4 ;P19 Edits of XML DATA to DC Cloud Web Service
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,ACD160
+4 NEW PAGE,PAGEX,STAT1,ZERO,ZNINE,ONCCSID,ONCCSTP,ONCREID,ONCDTTIM
+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 ACD160=$$GET1^DIQ(165.5,D0,.02,"I")
+9 DO PID^ONCOCOP
SET ONCCSID=X
+10 ;S ONCREID=$$ICN^ONCACDU2(ACD160)
+11 SET ONCREID=D0
+12 SET ONCCSTP=$$GET1^DIQ(165.5,D0,282,"I")
+13 SET BLANK=" "
+14 SET ZERO=0
+15 SET NINE=9
+16 SET ZNINE="09"
+17 SET EXTRACT=$ORDER(^ONCO(160.16,"B","VACCR EXTRACT V23.0",0))
+18 SET EXT="VACCR"
+19 SET EXTVER=$GET(^ONCO(160.16,EXTRACT,"FIELD",7,4))
+20 SET DEVICE=0
SET OIEN=0
SET PAGE=1
SET OUT=0
+21 SET OSP=$ORDER(^ONCO(160.1,"C",DUZ(2),0))
+22 IF OSP=""
SET OSP=$ORDER(^ONCO(160.1,0))
+23 SET IINPNT=$PIECE($GET(^ONCO(160.1,OSP,1)),U,4)
+24 SET DXH=$$GET1^DIQ(160.19,IINPNT,.01,"I")
+25 SET STAT1=DXH
+26 SET PAGE=1
+27 SET IEN=D0
+28 SET ONCDST=$NAME(^TMP("ONC",$JOB))
+29 SET MSGLST=$NAME(^TMP("ONC1",$JOB))
+30 ;P19
+31 ;build XML request header
DO XMLHDR^ONCSED01
+32 ;build XML request message body
DO XMLEDIT^ONCSED01
+33 ;clear the response ^TMP global
KILL ^TMP("ONCSED01R",$JOB)
+34 ;send request to cloud server
SET ONCEXEC="P"
DO T3^ONCWEB1
+35 ;new code parse rspns from cloud server
SET ERRFLG=0
DO PARSE^ONCWEBP1
+36 ;error in server call
IF ERRFLG=2
WRITE !,"XML/server problem"
QUIT
+37 ;display EDITs errors from server
IF ERRFLG=1
DO DISPLAY^ONCWEBP1
QUIT
+38 ;case complete
IF ERRFLG=0
QUIT
+39 ;
+40 ;S RC=$$PARSE^ONCSED02(.ONCSAPI,ONC8RDAT,ONC8MSG) ;this is part of P19 testing
+41 ;S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST) ;comment for testing
+42 ;S RC=$$RBQPREP^ONCSED01(.ONCSAPI,.ONCDST,"DEBUG") ;comment for cloud server
+43 ;S ERRFLG=RC ; comment out for Patch 19
+44 ;I RC<0 D PRTERRS^ONCSAPIE() Q ; comment out for Patch 19
+45 ;
+46 NEW D0
+47 DO OUTPUT(IEN,EXTRACT,.OUT)
+48 IF $GET(EDITS)="NO"
DO END^ONCSNACR(.ONCDST)
QUIT
+49 ;
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
