- 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 Feb 18, 2025@23:49:17 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