120 lines
3.8 KiB
Mathematica
120 lines
3.8 KiB
Mathematica
ONCOEDC ;Hines OIFO/GWB - ABSTRACT STATUS (165.5,91) INPUT TRANSFORM ;8/2/96
|
|
;;2.11;ONCOLOGY;**6,7,13,27,36,41,47**;Mar 07,1995;Build 19
|
|
;
|
|
CHECK ;Required field check
|
|
;CLASS OF CASE = 0,1 or 2
|
|
;SEQUENCE NUMBER = 00-59 or 99
|
|
;DATE DX > 12/31/95
|
|
;
|
|
I (X=0)!(X=1)!(X=2) 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 CC=$P(NODE0,U,4),SQN=$P(NODE0,U,6),DTDX=$P(NODE0,U,16)
|
|
S ABSTAT=$P($G(^ONCO(165.5,D0,7)),U,2)
|
|
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=0)!(CC=1)!(CC=2),(+SQN<60)!(SQN=99),DTDX>2951231 S ONCANL=1 D CHKFLDS
|
|
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 override 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 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,39,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 !
|
|
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(IOST?1"C".E: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
|
|
W !," Calling EDITS API..."
|
|
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)=DT
|
|
.S ^ONCO(165.5,"AAD",DT,PRM)=""
|
|
.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",DT,PRM)
|
|
..S $P(^ONCO(165.5,D0,7),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 $P(^ONCO(165.5,D0,7),U,2)=3
|
|
I DCC'="" D
|
|
.I DCLC'="" K ^ONCO(165.5,"AAE",DCLC,PRM)
|
|
.S $P(^ONCO(165.5,PRM,7),U,21)=DT
|
|
.S ^ONCO(165.5,"AAE",DT,PRM)=""
|
|
.S $P(^ONCO(165.5,PRM,7),U,22)=DUZ
|
|
W !
|
|
W !," ABSTRACT STATUS.......: ",$$GET1^DIQ(165.5,D0,91,"E")
|
|
W !," DATE CASE COMPLETED...: ",$$GET1^DIQ(165.5,D0,90,"E")
|
|
W !," ABSTRACTED BY.........: ",$$GET1^DIQ(165.5,D0,92,"E")
|
|
W !," DATE CASE LAST CHANGED: ",$$GET1^DIQ(165.5,D0,198,"E")
|
|
W !," CASE LAST CHANGED BY..: ",$$GET1^DIQ(165.5,D0,199,"E")
|
|
W !
|
|
S EDITS="NO" D NAACCR^ONCGENED K EDITS
|
|
D CHKSUM^ONCGENED
|
|
W ! R "Enter RETURN to continue: ",PAUSE:30
|
|
Q
|