ONCOEDC ;HINES OIFO/GWB - ABSTRACT STATUS (165.5,91) Input Transform ;10/19/11
;;2.2;ONCOLOGY;**1,5,6,10,19**;Jul 31, 2013;Build 4
;
CHECK ;Required field check
;CLASS OF CASE = 00-22
;SEQUENCE NUMBER = 00-59 or 99
;DATE DX > 12/31/95
N ABSTAT,CC,CMPLT,CNT,DCC,DCLC,DTDX,ERRFLG,EX,FDNUM,FLDNAME,FN,LINE
N NODE0,ONCANL,ONCFILE,PAUSE,PRM,PTN,SQN
;next line added to set Abstracted By field for Accession Only cases
I X="A",$P(^ONCO(165.5,D0,7),U,3)="" S $P(^ONCO(165.5,D0,7),U,3)=DUZ
I (X=0)!(X=1)!(X=2)!(X="A")!(X="D") Q
S PRM=D0
S PTN=$P($G(^ONCO(165.5,D0,0)),U,2)
S CMPLT=1,NODE0=$G(^ONCO(165.5,D0,0)),ONCTYP="",ONCANL="" K LIST
S (COC,CC)=$E($$GET1^DIQ(165.5,D0,.04),1,2)
S SQN=$P(NODE0,U,6),DTDX=$P(NODE0,U,16)
S ABSTAT=$P($G(^ONCO(165.5,D0,7)),U,2)
I DTDX>3171231 D OBS2018^ONCOEDC2
I CC="" D S ONCTYP="" K X Q
.W !
.W !?5,"CLASS OF CLASS is blank."
.W !?5,"""Required"" field checking requires CLASS OF CASE."
.W !
I +CC<23,(+SQN<60)!(SQN=99),DTDX>2951231 S ONCANL=1 D CHKFLDS
;follow-up and approach fields must be entered.
N ONCFOLDT,ONCAUDT
I $D(^ONCO(160,PTN,1)) S ONCAUDT=$P(^ONCO(160,PTN,1),U,9)
S ONCFOLDT=$O(^ONCO(160,PTN,"F","B",9999999),-1)
I '$G(ONCAUDT) D
.I (ONCFOLDT="")!(ONCFOLDT<DTDX) S LIST("DATE OF LAST CONTACT OR DEATH")="" S CMPLT=0
I (DTDX>3091231),($$GET1^DIQ(165.5,PRM,234,"I")="") S CMPLT=0,LIST($P($G(^DD(165.5,234,0)),U,1))=""
;
I CMPLT=0 S ONCTYP="A" K X Q
I CMPLT=1 D
.I $G(ONCANL)=1 D
..W !!," All required data fields have been entered."
..W !!," Beginning inter-field edit checks..." Q
.W ! D ^ONCEDIT
I CMPLT=1 W !," No inter-field edit check warnings.",! D EDITS Q
I $G(OVERRIDE)="NO" G QUIT
K DIR S DIR(0)="YA"
S DIR("A",1)=" This abstract has inter-field WARNINGS."
S DIR("A")=" Do you wish to ignore them and proceed to the EDITS API? "
S DIR("B")="No" D ^DIR K DIR
I Y=1 S X=3 W ! D EDITS Q
QUIT K OVERRIDE
S EDIT="YES"
S ONCTYP="B" W ! S X=ABSTAT Q
;
CHKFLDS ;Check ONCOLOGY PRIMARY (165.5) and ONCOLOGY PATIENT (160)
S ONCFILE=165.5 D F1655^ONCOEDC1
S ONCFILE=160 D F160
Q
;
F160 ;ONCOLOGY PATIENT (160)
F FDNUM=2,3,7,8,9,10,38,43 D
.D:$$GET1^DIQ(160,PTN,FDNUM,"I")="" CMPLT
Q
;
CMPLT ;Set CMPLT = 0 and add field to list of fields needed to be filled in.
S FLDNAME=$P($G(^DD(ONCFILE,FDNUM,0)),U,1) S FDNUM=""
S CMPLT=0,LIST(FLDNAME)=""
Q
;
PRINT ;Display results
I $G(ONCTYP)="" Q
I ONCTYP="A" D REQ
I ONCTYP="B" D INTER
W !
K ONCTYP
Q
;
REQ ;Missing "required" data item list
W !," ABSTRACT STATUS may not be set to COMPLETE unless"
W !," all ""required"" data items have been entered.",!
W !," The following ""required"" data items have not been"
W !," entered for this primary:",!
S EX="",LINE=$S($E(IOST,1,2)="C-":IOSL-2,1:IOSL-6),CNT=0
S FN=""
F S FN=$O(LIST(FN)),CNT=CNT+1 Q:FN="" W !,?2,FN I CNT>14 D PCHK Q:EX=U
Q
;
INTER ;Interfield edit warnings
;W !?5,"ABSTRACT STATUS may not be set to COMPLETE until all interfield"
;W !?5,"warnings listed above have been cleared."
Q
;
PCHK ;Enter RETURN to continue or '^' to exit:
I ($Y'<(LINE-1)) D Q:EX=U W !
.W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
.W @IOF Q
Q
;
EDITS ;Call to EDITS API
S ERRFLG=0
;Q:($G(ONCOEDIT)=1)
W !," Calling EDITS API..."
N ONCDST,ONCSAPI,ONCDTTIM,ONCDTEMP
D NOW^%DTC S ONCDTTIM=%
S DCC=$P($G(^ONCO(165.5,D0,7)),U,1)
S DCLC=$P($G(^ONCO(165.5,D0,7)),U,21)
I DCC="" D
.S $P(^ONCO(165.5,PRM,7),U,1)=ONCDTTIM
.S ^ONCO(165.5,"AAD",ONCDTTIM,PRM)=""
.S $P(^ONCO(165.5,PRM,7),U,3)=DUZ
.S $P(^ONCO(165.5,PRM,"EDITS"),U,3)="N"
I ABSTAT=3,$P($G(^ONCO(165.5,D0,7)),U,3)="" S $P(^ONCO(165.5,PRM,7),U,3)=DUZ
I DCC'="",$P($G(^ONCO(165.5,D0,7)),U,3)="" S $P(^ONCO(165.5,PRM,7),U,3)=DUZ
D ^ONCGENED
K EDIT
I ERRFLG'=0 D Q
.I ABSTAT=3 W !!,"EDITS errors were encountered. ABSTRACT STATUS changed to 0 (Incomplete).",!
.I ABSTAT'=3 W !!,"EDITS errors were encountered. ABSTRACT STATUS is unchanged.",!
.I DCC="" D
..S $P(^ONCO(165.5,D0,7),U,1)=""
..K ^ONCO(165.5,"AAD",ONCDTTIM,PRM)
..S $P(^ONCO(165.5,D0,7),U,3)=""
..S $P(^ONCO(165.5,D0,"EDITS"),U,3)=""
.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 EDIT="YES"
.S X=$S(ABSTAT=3:0,1:ABSTAT)
W !," No EDITS errors or warnings."
S SAVEX=3,$P(^ONCO(165.5,D0,7),U,2)=3,^ONCO(165.5,"AS",3,D0)=""
;S ONCEDC3=1,DIE="^ONCO(165.5,",DA=D0,DR="91///^S X=3" D ^DIE K ONCEDC3
I DCC'="" D
.I DCLC'="" K ^ONCO(165.5,"AAE",DCLC,PRM)
.S $P(^ONCO(165.5,PRM,7),U,21)=ONCDTTIM
.S ^ONCO(165.5,"AAE",DT,PRM)=""
.S $P(^ONCO(165.5,PRM,7),U,22)=DUZ
.S:$P(^ONCO(165.5,PRM,7),U,3)="" $P(^ONCO(165.5,PRM,7),U,3)=DUZ
W !
W !," ABSTRACT STATUS.............: ",$$GET1^DIQ(165.5,D0,91,"E")
W !," DATE CASE INITIATED.........: ",$$GET1^DIQ(165.5,D0,236,"E")
W !," INITIATED BY................: ",$$GET1^DIQ(165.5,D0,244,"E")
W !," DATE OF FIRST CONTACT.......: ",$$GET1^DIQ(165.5,D0,155,"E")
W !," DATE CASE COMPLETED.........: " S ONCDTEMP=$P($G(^ONCO(165.5,D0,7)),U,1) W $$FMTE^XLFDT(ONCDTEMP,"5P")
W !," ELAPSED DAYS TO COMPLETION..: ",$$GET1^DIQ(165.5,D0,157,"E")
;W !," ELAPSED MONTHS TO COMPLETION: ",$$GET1^DIQ(165.5,D0,157.1,"E")
W !," ABSTRACTED BY...............: ",$$GET1^DIQ(165.5,D0,92,"E")
W !," DATE CASE LAST CHANGED......: " S ONCDTEMP=$P($G(^ONCO(165.5,D0,7)),U,21) W $$FMTE^XLFDT(ONCDTEMP,"5P")
W !," CASE LAST CHANGED BY........: ",$$GET1^DIQ(165.5,D0,199,"E")
W !
S EDITS="NO" D NAACCR^ONCGENED K EDITS
S ONCDST=$NA(^TMP("ONC",$J))
D CHKSUM^ONCGENED
W ! R "Enter RETURN to continue: ",PAUSE:30
I $G(SAVEX)=3 S X=3
Q
;
CLEANUP ;Cleanup
K COC,D0,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOEDC 5783 printed Oct 16, 2024@18:25:34 Page 2
ONCOEDC ;HINES OIFO/GWB - ABSTRACT STATUS (165.5,91) Input Transform ;10/19/11
+1 ;;2.2;ONCOLOGY;**1,5,6,10,19**;Jul 31, 2013;Build 4
+2 ;
CHECK ;Required field check
+1 ;CLASS OF CASE = 00-22
+2 ;SEQUENCE NUMBER = 00-59 or 99
+3 ;DATE DX > 12/31/95
+4 NEW ABSTAT,CC,CMPLT,CNT,DCC,DCLC,DTDX,ERRFLG,EX,FDNUM,FLDNAME,FN,LINE
+5 NEW NODE0,ONCANL,ONCFILE,PAUSE,PRM,PTN,SQN
+6 ;next line added to set Abstracted By field for Accession Only cases
+7 IF X="A"
IF $PIECE(^ONCO(165.5,D0,7),U,3)=""
SET $PIECE(^ONCO(165.5,D0,7),U,3)=DUZ
+8 IF (X=0)!(X=1)!(X=2)!(X="A")!(X="D")
QUIT
+9 SET PRM=D0
+10 SET PTN=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
+11 SET CMPLT=1
SET NODE0=$GET(^ONCO(165.5,D0,0))
SET ONCTYP=""
SET ONCANL=""
KILL LIST
+12 SET (COC,CC)=$EXTRACT($$GET1^DIQ(165.5,D0,.04),1,2)
+13 SET SQN=$PIECE(NODE0,U,6)
SET DTDX=$PIECE(NODE0,U,16)
+14 SET ABSTAT=$PIECE($GET(^ONCO(165.5,D0,7)),U,2)
+15 IF DTDX>3171231
DO OBS2018^ONCOEDC2
+16 IF CC=""
Begin DoDot:1
+17 WRITE !
+18 WRITE !?5,"CLASS OF CLASS is blank."
+19 WRITE !?5,"""Required"" field checking requires CLASS OF CASE."
+20 WRITE !
End DoDot:1
SET ONCTYP=""
KILL X
QUIT
+21 IF +CC<23
IF (+SQN<60)!(SQN=99)
IF DTDX>2951231
SET ONCANL=1
DO CHKFLDS
+22 ;follow-up and approach fields must be entered.
+23 NEW ONCFOLDT,ONCAUDT
+24 IF $DATA(^ONCO(160,PTN,1))
SET ONCAUDT=$PIECE(^ONCO(160,PTN,1),U,9)
+25 SET ONCFOLDT=$ORDER(^ONCO(160,PTN,"F","B",9999999),-1)
+26 IF '$GET(ONCAUDT)
Begin DoDot:1
+27 IF (ONCFOLDT="")!(ONCFOLDT<DTDX)
SET LIST("DATE OF LAST CONTACT OR DEATH")=""
SET CMPLT=0
End DoDot:1
+28 IF (DTDX>3091231)
IF ($$GET1^DIQ(165.5,PRM,234,"I")="")
SET CMPLT=0
SET LIST($PIECE($GET(^DD(165.5,234,0)),U,1))=""
+29 ;
+30 IF CMPLT=0
SET ONCTYP="A"
KILL X
QUIT
+31 IF CMPLT=1
Begin DoDot:1
+32 IF $GET(ONCANL)=1
Begin DoDot:2
+33 WRITE !!," All required data fields have been entered."
+34 WRITE !!," Beginning inter-field edit checks..."
QUIT
End DoDot:2
+35 WRITE !
DO ^ONCEDIT
End DoDot:1
+36 IF CMPLT=1
WRITE !," No inter-field edit check warnings.",!
DO EDITS
QUIT
+37 IF $GET(OVERRIDE)="NO"
GOTO QUIT
+38 KILL DIR
SET DIR(0)="YA"
+39 SET DIR("A",1)=" This abstract has inter-field WARNINGS."
+40 SET DIR("A")=" Do you wish to ignore them and proceed to the EDITS API? "
+41 SET DIR("B")="No"
DO ^DIR
KILL DIR
+42 IF Y=1
SET X=3
WRITE !
DO EDITS
QUIT
QUIT KILL OVERRIDE
+1 SET EDIT="YES"
+2 SET ONCTYP="B"
WRITE !
SET X=ABSTAT
QUIT
+3 ;
CHKFLDS ;Check ONCOLOGY PRIMARY (165.5) and ONCOLOGY PATIENT (160)
+1 SET ONCFILE=165.5
DO F1655^ONCOEDC1
+2 SET ONCFILE=160
DO F160
+3 QUIT
+4 ;
F160 ;ONCOLOGY PATIENT (160)
+1 FOR FDNUM=2,3,7,8,9,10,38,43
Begin DoDot:1
+2 if $$GET1^DIQ(160,PTN,FDNUM,"I")=""
DO CMPLT
End DoDot:1
+3 QUIT
+4 ;
CMPLT ;Set CMPLT = 0 and add field to list of fields needed to be filled in.
+1 SET FLDNAME=$PIECE($GET(^DD(ONCFILE,FDNUM,0)),U,1)
SET FDNUM=""
+2 SET CMPLT=0
SET LIST(FLDNAME)=""
+3 QUIT
+4 ;
PRINT ;Display results
+1 IF $GET(ONCTYP)=""
QUIT
+2 IF ONCTYP="A"
DO REQ
+3 IF ONCTYP="B"
DO INTER
+4 WRITE !
+5 KILL ONCTYP
+6 QUIT
+7 ;
REQ ;Missing "required" data item list
+1 WRITE !," ABSTRACT STATUS may not be set to COMPLETE unless"
+2 WRITE !," all ""required"" data items have been entered.",!
+3 WRITE !," The following ""required"" data items have not been"
+4 WRITE !," entered for this primary:",!
+5 SET EX=""
SET LINE=$SELECT($EXTRACT(IOST,1,2)="C-":IOSL-2,1:IOSL-6)
SET CNT=0
+6 SET FN=""
+7 FOR
SET FN=$ORDER(LIST(FN))
SET CNT=CNT+1
if FN=""
QUIT
WRITE !,?2,FN
IF CNT>14
DO PCHK
if EX=U
QUIT
+8 QUIT
+9 ;
INTER ;Interfield edit warnings
+1 ;W !?5,"ABSTRACT STATUS may not be set to COMPLETE until all interfield"
+2 ;W !?5,"warnings listed above have been cleared."
+3 QUIT
+4 ;
PCHK ;Enter RETURN to continue or '^' to exit:
+1 IF ($Y'<(LINE-1))
Begin DoDot:1
+2 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+3 WRITE @IOF
QUIT
End DoDot:1
if EX=U
QUIT
WRITE !
+4 QUIT
+5 ;
EDITS ;Call to EDITS API
+1 SET ERRFLG=0
+2 ;Q:($G(ONCOEDIT)=1)
+3 WRITE !," Calling EDITS API..."
+4 NEW ONCDST,ONCSAPI,ONCDTTIM,ONCDTEMP
+5 DO NOW^%DTC
SET ONCDTTIM=%
+6 SET DCC=$PIECE($GET(^ONCO(165.5,D0,7)),U,1)
+7 SET DCLC=$PIECE($GET(^ONCO(165.5,D0,7)),U,21)
+8 IF DCC=""
Begin DoDot:1
+9 SET $PIECE(^ONCO(165.5,PRM,7),U,1)=ONCDTTIM
+10 SET ^ONCO(165.5,"AAD",ONCDTTIM,PRM)=""
+11 SET $PIECE(^ONCO(165.5,PRM,7),U,3)=DUZ
+12 SET $PIECE(^ONCO(165.5,PRM,"EDITS"),U,3)="N"
End DoDot:1
+13 IF ABSTAT=3
IF $PIECE($GET(^ONCO(165.5,D0,7)),U,3)=""
SET $PIECE(^ONCO(165.5,PRM,7),U,3)=DUZ
+14 IF DCC'=""
IF $PIECE($GET(^ONCO(165.5,D0,7)),U,3)=""
SET $PIECE(^ONCO(165.5,PRM,7),U,3)=DUZ
+15 DO ^ONCGENED
+16 KILL EDIT
+17 IF ERRFLG'=0
Begin DoDot:1
+18 IF ABSTAT=3
WRITE !!,"EDITS errors were encountered. ABSTRACT STATUS changed to 0 (Incomplete).",!
+19 IF ABSTAT'=3
WRITE !!,"EDITS errors were encountered. ABSTRACT STATUS is unchanged.",!
+20 IF DCC=""
Begin DoDot:2
+21 SET $PIECE(^ONCO(165.5,D0,7),U,1)=""
+22 KILL ^ONCO(165.5,"AAD",ONCDTTIM,PRM)
+23 SET $PIECE(^ONCO(165.5,D0,7),U,3)=""
+24 SET $PIECE(^ONCO(165.5,D0,"EDITS"),U,3)=""
End DoDot:2
+25 KILL DIR
SET DIR(0)="YA"
+26 SET DIR("A")=" Do you wish to return to the Primary Menu Options? "
+27 SET DIR("B")="Yes"
DO ^DIR
KILL DIR
+28 IF Y=1
SET EDIT="YES"
+29 SET X=$SELECT(ABSTAT=3:0,1:ABSTAT)
End DoDot:1
QUIT
+30 WRITE !," No EDITS errors or warnings."
+31 SET SAVEX=3
SET $PIECE(^ONCO(165.5,D0,7),U,2)=3
SET ^ONCO(165.5,"AS",3,D0)=""
+32 ;S ONCEDC3=1,DIE="^ONCO(165.5,",DA=D0,DR="91///^S X=3" D ^DIE K ONCEDC3
+33 IF DCC'=""
Begin DoDot:1
+34 IF DCLC'=""
KILL ^ONCO(165.5,"AAE",DCLC,PRM)
+35 SET $PIECE(^ONCO(165.5,PRM,7),U,21)=ONCDTTIM
+36 SET ^ONCO(165.5,"AAE",DT,PRM)=""
+37 SET $PIECE(^ONCO(165.5,PRM,7),U,22)=DUZ
+38 if $PIECE(^ONCO(165.5,PRM,7),U,3)=""
SET $PIECE(^ONCO(165.5,PRM,7),U,3)=DUZ
End DoDot:1
+39 WRITE !
+40 WRITE !," ABSTRACT STATUS.............: ",$$GET1^DIQ(165.5,D0,91,"E")
+41 WRITE !," DATE CASE INITIATED.........: ",$$GET1^DIQ(165.5,D0,236,"E")
+42 WRITE !," INITIATED BY................: ",$$GET1^DIQ(165.5,D0,244,"E")
+43 WRITE !," DATE OF FIRST CONTACT.......: ",$$GET1^DIQ(165.5,D0,155,"E")
+44 WRITE !," DATE CASE COMPLETED.........: "
SET ONCDTEMP=$PIECE($GET(^ONCO(165.5,D0,7)),U,1)
WRITE $$FMTE^XLFDT(ONCDTEMP,"5P")
+45 WRITE !," ELAPSED DAYS TO COMPLETION..: ",$$GET1^DIQ(165.5,D0,157,"E")
+46 ;W !," ELAPSED MONTHS TO COMPLETION: ",$$GET1^DIQ(165.5,D0,157.1,"E")
+47 WRITE !," ABSTRACTED BY...............: ",$$GET1^DIQ(165.5,D0,92,"E")
+48 WRITE !," DATE CASE LAST CHANGED......: "
SET ONCDTEMP=$PIECE($GET(^ONCO(165.5,D0,7)),U,21)
WRITE $$FMTE^XLFDT(ONCDTEMP,"5P")
+49 WRITE !," CASE LAST CHANGED BY........: ",$$GET1^DIQ(165.5,D0,199,"E")
+50 WRITE !
+51 SET EDITS="NO"
DO NAACCR^ONCGENED
KILL EDITS
+52 SET ONCDST=$NAME(^TMP("ONC",$JOB))
+53 DO CHKSUM^ONCGENED
+54 WRITE !
READ "Enter RETURN to continue: ",PAUSE:30
+55 IF $GET(SAVEX)=3
SET X=3
+56 QUIT
+57 ;
CLEANUP ;Cleanup
+1 KILL COC,D0,Y
