Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOAIF

ONCOAIF.m

Go to the documentation of this file.
  1. ONCOAIF ;HINES OIFO/GWB - [PF Post/Edit Follow-up] ;11/08/10
  1. ;;2.2;ONCOLOGY;**1,4,5,6,17,18**;Jul 31, 2013;Build 5
  1. ;
  1. BEG W @IOF,!," Post/Edit Follow-up"
  1. W !," -------------------",!
  1. Q
  1. ;
  1. PAT ;[PF Post/Edit Follow-up]
  1. N ONCDUZ,ONCDT
  1. S ONCDUZ=DUZ,ONCDT=DT
  1. D BEG
  1. S DIC("A")=" Post/Edit Follow-Up for patient: "
  1. S DIC="^ONCO(160,",DIC(0)="AEMQZ" D ^DIC K DIC
  1. G KILL:Y<0
  1. S (ONCOD0,DA,D0)=+Y,ONCONM=Y(0,0)
  1. D SUM,LST^ONCODLF G DIE
  1. ;
  1. LST ;Follow-Up
  1. W @IOF,!!," **********FOLLOW-UP**********",!!
  1. W " Patient: ",ONCONM
  1. W:$D(XDD) !," Date of Inpatient Discharge: ",XDD
  1. Q
  1. ;
  1. EN ;FOLLOW-UP entry when patient has been pre-selected
  1. K F,DIC,DO,ONCOD1,LC,VS,NF,XDT,XDD,XR
  1. S ONCDUZ=DUZ,ONCDT=DT
  1. S PRESEL=1
  1. ;S XDT=$S('$D(ONCOD0P):"",1:$$GET1^DIQ(165.5,ONCOD0P,1.1,"I"))
  1. S XDT=""
  1. I (XDT="")!(XDT="0000000")!(XDT="9999999") D LST G DIE
  1. D DD S F=$P($G(^ONCO(160,ONCOD0,"F",0)),U,4)
  1. I F<1 D DLC,LST S F=1 G DIE
  1. RF S D0=ONCOD0 W !! K DXS,DIOT D BEG W ! D LST^ONCODLF G DIE
  1. ;
  1. DIE K DXS
  1. ;P6.
  1. K ^TMP("ONCFOL",160,$J)
  1. M ^TMP("ONCFOL",160,$J,ONCOD0)=^ONCO(160,ONCOD0,"F")
  1. S ONCDUZ=DUZ,ONCDT=DT
  1. S ONCOSTAT=1,DA=ONCOD0,DR="[ONCO FOLLOWUP]",DIE="^ONCO(160,",FG=0
  1. W ! D ^DIE
  1. I 'FG S ONCOVS="" D UPOUT,CHKCMP I $G(FOLINP)="YES" G DIE
  1. I $O(^ONCO(160,ONCOD0,"F",0))="" Q
  1. ; D CHKCHG
  1. S XD0=ONCOD0 D DUPPRI^ONCFUNC
  1. I 'FG D CHKCHG Q
  1. ;
  1. UPDAT S D0=ONCOD0 K DXS,DIOT W ! D LST^ONCODLF,UPD^ONCOCRF
  1. N Y,ONCOD,YSAVE
  1. K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
  1. D EN^DIQ1 W !
  1. W !," Name..: ",ONC(160,ONCOD0,.01)
  1. W ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
  1. W !," Status: ",ONC(160,ONCOD0,15)
  1. W ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
  1. D SUM
  1. C K DIR S DIR("A")="DATA OK",DIR("B")="Yes",DIR(0)="Y"
  1. ;D ^DIR Q:(Y=U)!(Y="") G DIE:'Y
  1. D ^DIR S YSAVE=Y I (Y=U)!(Y="") D CHKCHG S Y=YSAVE Q ;Q:(Y=U)!(Y="") G DIE:'Y
  1. G DIE:'Y
  1. I ONCOVS G KILL:$G(ONCRFOPT)=1 S ONCFRMPF=1 G REC ;G KILL:$D(PRESEL) G PAT:'$D(REC),REC
  1. W !! D DEAD^ONCOFDP
  1. Q:$D(ONCOAI) G REC:$D(REC) D KILL K ONCONM S ONCOD=1 Q
  1. ;
  1. UPOUT ;Up-arrow out check before deleting
  1. Q:'$D(ONCOD1)
  1. Q:'$D(^ONCO(160,ONCOD0,"F",ONCOD1,0))
  1. Q:$P(^ONCO(160,ONCOD0,"F",ONCOD1,0),U,8)=1
  1. D DEL
  1. Q
  1. ;
  1. DEL ;Delete FOLLOW-UP entry
  1. S DA(1)=ONCOD0,DA=ONCOD1,DIK="^ONCO(160,"_DA(1)_",""F"","
  1. D ^DIK S ONCOVS=""
  1. W:$D(^ONCO(160,ONCOD0,"F",ONCOD1,0)) $P(^(0),U,8)
  1. W !!," *********************ENTRY DELETED*************************"
  1. W !!," You have not entered all of the required information."
  1. W !!,"(Last Tumor Status(es) have been reset for this patient's primary site(s).)",!!
  1. H 1
  1. Q
  1. ;
  1. CHKCMP ;Check for 'Complete" abstracts with no follow-up
  1. N AN,ASTAT,PID,PN,PRIM,PSCODE,SEQ
  1. Q:$O(^ONCO(160,ONCOD0,"F",0))'=""
  1. S PRIM=0 F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
  1. .I $P($G(^ONCO(165.5,PRIM,7)),U,2)=3 S ASTAT(PRIM)=""
  1. Q:'$D(ASTAT)
  1. W !
  1. W !," There is no follow-up information for this patient."
  1. W !," This patient has a 'Complete' abstract."
  1. W !," A 'Complete' abstract requires at least one follow-up."
  1. W !
  1. K DIR
  1. S DIR("A")=" Do you wish to enter a follow-up at this time"
  1. S DIR("B")="YES",DIR(0)="Y" D ^DIR
  1. I Y=1 S FOLINP="YES" Q
  1. S FOLINP="NO"
  1. S PRIM=0 F S PRIM=$O(ASTAT(PRIM)) Q:PRIM'>0 D
  1. .S DIE="^ONCO(165.5,"
  1. .S DA=PRIM
  1. .S DR="91///0;197///@"
  1. .D ^DIE
  1. W !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)"
  1. W !," for the following abstracts:",!
  1. S PRIM=0 F S PRIM=$O(ASTAT(PRIM)) Q:PRIM'>0 D
  1. .S PN=$$GET1^DIQ(165.5,PRIM,.02)
  1. .S AN=$$GET1^DIQ(165.5,PRIM,.05)
  1. .S SEQ=$$GET1^DIQ(165.5,PRIM,.06)
  1. .S PID=$$GET1^DIQ(165.5,PRIM,61)
  1. .S PSCODE=$$GET1^DIQ(165.5,PRIM,20.1)
  1. .W !?1,PID," ",PSCODE," ",AN,"/",SEQ
  1. .W !
  1. K DIR S DIR(0)="E" D ^DIR
  1. Q
  1. ;
  1. CHKCHG ;Check for checksum and Follow-up changes to 'Complete' abstracts
  1. N CHECKSUM,CNT,ONCDST,ONCDTTIM,ONCFF1,ONCFOL1,ERRFLG
  1. D NOW^%DTC S ONCDTTIM=%
  1. S (ONCFOL1,CNT)=0
  1. F ONCFF1=0:0 S ONCFF1=$O(^ONCO(160,ONCOD0,"F",ONCFF1)) Q:(ONCFF1'>0)!(ONCFOL1=1) D
  1. .W "."
  1. .I $G(^ONCO(160,ONCOD0,"F",ONCFF1,0))'=$G(^TMP("ONCFOL",160,$J,ONCOD0,ONCFF1,0)) S ONCFOL1=1
  1. ;
  1. W !!," Checking for changes to 'Complete' abstracts" S PRIM=0 F S PRIM=$O(^ONCO(165.5,"C",ONCOD0,PRIM)) Q:PRIM'>0 D
  1. .W "."
  1. .S DIE="^ONCO(165.5,",DA=PRIM,DR="198///^S X=ONCDTTIM" D ^DIE
  1. .I ($P($G(^ONCO(165.5,PRIM,7)),U,2)=3),($G(ONCFOL1)) D
  1. ..W !,"Calling EDITs API..."
  1. ..S ERRFLG=0
  1. ..;S EDITS="NO"
  1. ..S (DA,D0)=PRIM D ^ONCGENED K EDITS
  1. ..;check for error
  1. ..I ERRFLG'=0 D Q
  1. ...W !!," EDITS errors were encountered."
  1. ...W !!," The ABSTRACT STATUS has been changed to 0 (Incomplete)."
  1. ...S DIE="^ONCO(165.5,"
  1. ...S DR="91///0;197///@"
  1. ...D ^DIE
  1. ...W !
  1. ..S CNT=CNT+1
  1. ..S ONCDST=$NA(^TMP("ONC",$J))
  1. ..S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
  1. ..I CHECKSUM'=$P($G(^ONCO(165.5,PRIM,"EDITS")),U,1) D
  1. ...S $P(^ONCO(165.5,PRIM,"EDITS"),U,1)=CHECKSUM
  1. ...W !!," Re-computing checksum value for 'Complete' abstract ",$$GET1^DIQ(165.5,PRIM,.061)
  1. W:CNT=0 " No changes found."
  1. K ^TMP("ONC",$J)
  1. K ^TMP("ONCFOL",160,$J)
  1. Q
  1. ;
  1. REC ;[RF Recurrence/Sub Tx Follow-up]
  1. N D,ONCDUZ,ONCDT,TX
  1. S ONCDUZ=DUZ,ONCDT=DT
  1. S XR=1,REC="" W @IOF,!," Recurrence/Sub Tx Follow-up"
  1. W !," ---------------------------",!
  1. I $G(ONCFRMPF)=1 G RECPF ;if pt pre-selected from ^PF skip pt select
  1. S ONCRFOPT=1,DIC("A")="Select Patient for Recurrence: "
  1. S DIC="^ONCO(160,",DIC(0)="AEQMZ" D ^DIC K DIC
  1. G KILL:Y<0
  1. S (D0,ONCOD0)=+Y,ONCONM=Y(0,0)
  1. N Y
  1. RECPF K DIQ,ONC S DIC="^ONCO(160,",DR=".01;2;3;8;10;15",DA=ONCOD0,DIQ="ONC"
  1. D EN^DIQ1 W !
  1. W !?2,"Name.........: ",ONC(160,ONCOD0,.01)
  1. W ?35,"Race.........: ",ONC(160,ONCOD0,8)
  1. W !?2,"SSN..........: ",ONC(160,ONCOD0,2)
  1. W ?35,"Sex..........: ",ONC(160,ONCOD0,10)
  1. W !?2,"Date of Birth: ",ONC(160,ONCOD0,3)
  1. W ?35,"Status.......: ",ONC(160,ONCOD0,15)
  1. D SUM
  1. K DIC W !?1,"Select Primary for Recurrence: ",!
  1. ;S D="C",DIC="^ONCO(165.5,",X=ONCOD0,DIC(0)="EFZ" D IX^DIC G:Y<0 REC
  1. ;added Type of First Recurrence P *2.2*4
  1. N ONC16012,ONC1655
  1. S D="C",DIC="^ONCO(165.5,",X=ONCOD0,DIC(0)="EFZ"
  1. S DIC("W")="S ONC16012=$P($G(^(5)),U,2),ONC1655=+Y D FST^ONCODSP"
  1. D IX^DIC I Y<0 D CHKCHG,KILL Q ; G:Y<0 KILL
  1. I Y'=" " S (ONCOD0P,DA)=+Y,DR="[ONCO RECURRENCE FOLLOWUP]",DIE="^ONCO(165.5,",DATEDX=$P(^ONCO(165.5,DA,0),U,16),TX=$P($G(^ONCO(165.5,DA,2)),U,1) D ^DIE D CHKCHG S AB=2,ONCOD0P=D0 G EN:$D(ONCRFOPT)
  1. G KILL Q
  1. ;
  1. RE ;Recurrence
  1. W !!," Recurrence"," ----------"
  1. ; If Type of First Recurrence is not set yet, then check the
  1. ; Cancer Status field of Tumor Status multiple to set defaults for
  1. ; Type of First Rec, Rec Date 1st-Flag & Distant Sites 1-3 fields
  1. ; -- Called from [ONCO RECURRENCE FOLLOWUP] template --
  1. S ONCTOFR=$P($G(^ONCO(165.5,ONCOD0P,5)),"^",2) I ONCTOFR'="" K ONCTOFR Q
  1. S ONCTSDAT=$O(^ONCO(165.5,ONCOD0P,"TS","AA",0)) Q:ONCTSDAT=""
  1. S ONCTSIEN=$O(^ONCO(165.5,ONCOD0P,"TS","AA",ONCTSDAT,0)) Q:ONCTSIEN=""
  1. S ONCTSCS=$P($G(^ONCO(165.5,ONCOD0P,"TS",ONCTSIEN,0)),"^",2)
  1. S ONCTOFRV=""
  1. I ONCTSCS=1 S ONCTOFRV=$O(^ONCO(160.12,"B","00","")),ONCRD1F=11
  1. I ONCTSCS=2 S ONCTOFRV=$O(^ONCO(160.12,"B",70,"")),ONCRD1F=11
  1. I ONCTSCS=9 S ONCTOFRV=$O(^ONCO(160.12,"B",99,"")),ONCRD1F=10
  1. ;Hard set the nodes since we are within an Input Template when called
  1. ;so ^DIE not working - there are no X-refs to set
  1. S $P(^ONCO(165.5,ONCOD0P,5),U,3,5)="0^0^0"
  1. S $P(^ONCO(165.5,ONCOD0P,27),U,26)=ONCRD1F
  1. ;
  1. K ONCRD1F,ONCTOFR,ONCTOFRV,ONCTSDAT,ONCTSIEN,ONCTSCS Q
  1. ;
  1. STX ;Subsequent Course of Treatment
  1. W !!," Subsequent Course of Treatment"
  1. W !," ------------------------------"
  1. Q
  1. ;
  1. KILL ;Kill variables
  1. K ONCOSTAT,XR,DA,DIC,DIE,DIK,DIOT,DIR,DO,DR,DXS,F,FG,FOLINP
  1. K ONCOD1,ONCOLC,X,XD1,XD0,LC,ONCOVS,REC,YSAVE
  1. K AB,DATEDX,PRESEL,ONCFRMPF,ONCRFOPT
  1. K ^TMP("ONCFOL",160)
  1. Q
  1. ;
  1. DD ;Date format
  1. S XDD=$E(XDT,4,5)_"/"_$E(XDT,6,7)_"/"_($E(XDT,1,3)+1700) Q
  1. ;
  1. DLC ;Create FOLLOW-UP
  1. K DA
  1. S DA(1)=ONCOD0,DIC="^ONCO(160,"_DA(1)_","_"""F"""_","
  1. S DLAYGO=160,X=XDT,DIC(0)="ZL"
  1. I '$D(^ONCO(160,DA(1),"F")) S ^ONCO(160,DA(1),"F",0)="^160.04DAI^^"
  1. D FILE^DICN S ONCOLC=XDT,DIE=DIC,DR="1////1;2////2;" D ^DIE
  1. K DA,DIC,DLAYGO,DIE
  1. Q
  1. ;
  1. SUM ;Primary summary
  1. S XD0=D0
  1. N J,XD1 W !!
  1. S J=0,XD1=0 F S XD1=$O(^ONCO(165.5,"C",XD0,XD1)) Q:XD1'>0 I $D(^ONCO(165.5,XD1,0)) S J=J+1 D ^ONCOCOML
  1. Q
  1. ;
  1. CLEANUP ;Cleanup
  1. K D0,ONCOAI,ONCOD0,ONCOD0P