ONCOFUL ;Hines OIFO/GWB - FOLLOWUP PROCEDURES ;07/12/00
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
PAT ;Select patient
W !
S DIC="^ONCO(160,",DIC("A")=" Select Patient: ",DIC(0)="AEMQZ" D ^DIC
Q:(Y<0)!(+Y[U)
S (ONCOPAT,ONCOD0,DA)=+Y,X=Y(0,0),ONCOVP=$P(Y,U,2)
S X=$P(X,",",2)_" "_$P(X,","),ONCONM=$$LCASE^ONCOU(X)
Q
AP K ONCOD0,ONCOVP,ONCONM
DCL ;DISPLAY CONTACT LIST
W @IOF,!!,?20,"********* DISPLAY CONTACTS **********",!!
G FI:$D(ONCOVP)&($D(ONCOD0)) S DIC="^ONCO(160,",DIC("A")=" Select Patient: ",DIC(0)="AEMQZ" D ^DIC G EX:(Y<0)!(+Y[U) S (ONCOPAT,ONCOD0,DA)=+Y,X=Y(0,0),ONCOVP=$P(Y,U,2)
S LN=$P(X,","),X=$P(X,",",2)_" "_LN S ONCONM=$$LCASE^ONCOU(X)
FI S FIL=$P(ONCOVP,";",2),DFN=$P(ONCOVP,";"),GLR=U_FIL_DFN_",",X=$P(@(GLR_"0)"),U)
X K D1 S D0=ONCOD0,D1=$O(^ONCO(160,D0,"C","B","PT",0)) I D1="" D ^ONCOFUM
ADC ;ADD CONTACTS
K DXS,DIOT S D0=ONCOD0 D ^ONCOXCL
EC W !!?20,"********** ADD/EDIT CONTACTS **********",!! W:$D(ONCONM) ?20,"for: ",ONCONM,!!
S F0=0,DA=ONCOD0,DIE="^ONCO(160,",DR="[ONCO FOLL-ADD CONTACT]" D ^DIE ;G EX:'F0,EX:$D(Y)=0,DCL
SA S DIR("A")=" Select Action",DIR(0)="S^1:Display Contacts;2:Edit Contact;3:Attempt a Follow-up;4:Another Patient;5:Exit Option",DIR("B")=3 D ^DIR G DCL:Y=1,ATM:Y=3,EC:Y=2,AP:Y=4,EX
;
ATM ;[AF Attempt a Follow-up] [ONCO FOLL-ATTEMPT FOLLOWUP]
N ONCDUZ,ONCDT
S ONCDUZ=DUZ,ONCDT=DT
W @IOF,!!?20,"********** ATTEMPT A FOLLOW-UP **********",!!
K ONCOVS,VS,DIC,DIE
I '$D(ONCOD0) D PAT G EX:Y<0
E W:$D(ONCONM) ?20," for ",ONCONM
I '$D(ONCONM) D PAT G EX:Y<0
FA S DA=ONCOD0,DR="[ONCO FOLL ATTEMPT]",DIE="^ONCO(160,",L=0,FG=0 W !! D ^DIE G EX:$D(Y)'=0,EX:'$D(D1) I 'FG&'($P($G(^ONCO(160,D0,"A",D1,0)),U,6)) G DEL
S XX=^ONCO(160,ONCOD0,"A",ONCOD1,0) I $P(XX,U,2)=3&($P(XX,U,4)=8) S ONCOC0=$P(XX,U,3) W !!?5,"Generate Letter...!!" D LET^ONCOFUP K ONCOC0 G ATM
G SA:$G(XRS)'=1 W !!?10,"Complete Follow-up for Successful Contact!!",! G DIE:XTY=3
FOL K DXS S DA(1)=ONCOD0,DIC(0)="LZ",(DIE,DIC)="^ONCO(160,"_DA(1)_",""F"",",DLAYGO=160,X=XDT I '$D(^ONCO(160,DA(1),"F")) S ^ONCO(160,DA(1),"F",0)="^160.04DAI^^"
D ^DIC S DIE=DIE,DA=+Y G EX:Y<0
;DEVELOPERS NOTE: For consistent functionality, the following line
;must be identical to the 160.04 DR string in the input template
;ONCO FOLLOWUP.
FOLDR S DR="S ONCOD1=DA;.01;S LC=X;1;S VS=X;3;S:VS=0 Y=""@999"";4;6//^S X=""Chart requisition"";S NF=X S:X'=5 Y=""@1000"",UF="""";7;S UF=X;S Y=""@1000"";@999;4////8;6////9;S NF=9;@1000;5;8////1;D TEMP451^ONCOAIS;S FG=1;"
S FG=0 D ^DIE G UPDAT:FG I 'FG S ONCOVS="" D UPOUT G ATM
;
DIE K DXS S ONCOSTAT=1,DA=ONCOD0
S DR="[ONCO FOLLOWUP]"
S DIE="^ONCO(160,",FG=0 W !! D ^DIE I 'FG S ONCOVS="" G UPOUT
;
UPDAT S D0=ONCOD0 K DXS,DIOT D LST^ONCODLF,UPD^ONCOCRF
W !,?5,"**********Following fields have been updated********",!
N Y K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
D EN^DIQ1 W !
W !?2,"Name..: ",ONC(160,ONCOD0,.01)
W ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
W !?2,"Status: ",ONC(160,ONCOD0,15)
W ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
K DIR S DIR("A")=" DATA OK",DIR("B")="Yes",DIR(0)="Y" W !!
D ^DIR Q:(Y=U)!(Y="") G DIE:'Y,SA:ONCOVS D DEAD^ONCOFDP K ONCONM G ATM
;
UPOUT ;UPARROW out-check before deleting
Q:'$D(ONCOD1) Q:'$D(^ONCO(160,ONCOD0,"F",ONCOD1,0)) Q:$P(^(0),U,8)=1 D DEL^ONCOAIF G ATM
Q
;
DEL ;delete entry
Q:'$D(ONCOD1) S DA(1)=ONCOD0,DA=ONCOD1,DIK="^ONCO(160,"_DA(1)_",""A""," D ^DIK
W:$D(^ONCO(160,ONCOD0,"A",ONCOD1,0)) "*",$P(^(0),U,6) W !!,?10,"*********************ENTRY DELETED*************************",!!
G EX
IN ;
NAM D HD W !! S DIC="^ONCO(160,",DIC(0)="AEQMZ",DIC("A")=" Enter Patient name: " D ^DIC G EX:Y<0 S (ONCOD0,D0)=+Y
T K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G NAM
I '$D(IO("Q")) D TSK^ONCOFUL G EX
S ZTRTN="TSK^ONCOFUL",ZTSAVE("ONCOD0")="",ZTDESC="ONCOLOGY PATIENT INQUIRY" D ^%ZTLOAD G EX
;
TSK ;Task for Patient Inquiry
DI U IO D HD S D0=ONCOD0
K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
D EN^DIQ1 W !
W !?2,"Name..: ",ONC(160,ONCOD0,.01)
W ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
W !?2,"Status: ",ONC(160,ONCOD0,15)
W ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
D SUM^ONCOAIF,LST^ONCODLF
D ^%ZISC
Q
;
HD W @IOF,!!!?15,"********** Patient Follow-up Inquiry ***********",!
Q
EX ;EXIT ROUTINE
K DA,D0,D1,DI,DIC,DIC1,DIE,DIK,ONCOD0,ONCOD1,ONCOVS,ONCONM,ONCOPAT,ONCOVP,%ZISOS
K S,F0,FIL,GLR,J,LN,L,LA,NM,OD,OS,OF,%Y,ABS,AC,P,D,DN,DXS,DIYS,DN,ZZL,DIE,DR,ONCON,ONCOX
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOFUL 4586 printed Sep 23, 2025@20:01:10 Page 2
ONCOFUL ;Hines OIFO/GWB - FOLLOWUP PROCEDURES ;07/12/00
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
PAT ;Select patient
+1 WRITE !
+2 SET DIC="^ONCO(160,"
SET DIC("A")=" Select Patient: "
SET DIC(0)="AEMQZ"
DO ^DIC
+3 if (Y<0)!(+Y[U)
QUIT
+4 SET (ONCOPAT,ONCOD0,DA)=+Y
SET X=Y(0,0)
SET ONCOVP=$PIECE(Y,U,2)
+5 SET X=$PIECE(X,",",2)_" "_$PIECE(X,",")
SET ONCONM=$$LCASE^ONCOU(X)
+6 QUIT
AP KILL ONCOD0,ONCOVP,ONCONM
DCL ;DISPLAY CONTACT LIST
+1 WRITE @IOF,!!,?20,"********* DISPLAY CONTACTS **********",!!
+2 if $DATA(ONCOVP)&($DATA(ONCOD0))
GOTO FI
SET DIC="^ONCO(160,"
SET DIC("A")=" Select Patient: "
SET DIC(0)="AEMQZ"
DO ^DIC
if (Y<0)!(+Y[U)
GOTO EX
SET (ONCOPAT,ONCOD0,DA)=+Y
SET X=Y(0,0)
SET ONCOVP=$PIECE(Y,U,2)
+3 SET LN=$PIECE(X,",")
SET X=$PIECE(X,",",2)_" "_LN
SET ONCONM=$$LCASE^ONCOU(X)
FI SET FIL=$PIECE(ONCOVP,";",2)
SET DFN=$PIECE(ONCOVP,";")
SET GLR=U_FIL_DFN_","
SET X=$PIECE(@(GLR_"0)"),U)
X KILL D1
SET D0=ONCOD0
SET D1=$ORDER(^ONCO(160,D0,"C","B","PT",0))
IF D1=""
DO ^ONCOFUM
ADC ;ADD CONTACTS
+1 KILL DXS,DIOT
SET D0=ONCOD0
DO ^ONCOXCL
EC WRITE !!?20,"********** ADD/EDIT CONTACTS **********",!!
if $DATA(ONCONM)
WRITE ?20,"for: ",ONCONM,!!
+1 ;G EX:'F0,EX:$D(Y)=0,DCL
SET F0=0
SET DA=ONCOD0
SET DIE="^ONCO(160,"
SET DR="[ONCO FOLL-ADD CONTACT]"
DO ^DIE
SA SET DIR("A")=" Select Action"
SET DIR(0)="S^1:Display Contacts;2:Edit Contact;3:Attempt a Follow-up;4:Another Patient;5:Exit Option"
SET DIR("B")=3
DO ^DIR
if Y=1
GOTO DCL
if Y=3
GOTO ATM
if Y=2
GOTO EC
if Y=4
GOTO AP
GOTO EX
+1 ;
ATM ;[AF Attempt a Follow-up] [ONCO FOLL-ATTEMPT FOLLOWUP]
+1 NEW ONCDUZ,ONCDT
+2 SET ONCDUZ=DUZ
SET ONCDT=DT
+3 WRITE @IOF,!!?20,"********** ATTEMPT A FOLLOW-UP **********",!!
+4 KILL ONCOVS,VS,DIC,DIE
+5 IF '$DATA(ONCOD0)
DO PAT
if Y<0
GOTO EX
+6 IF '$TEST
if $DATA(ONCONM)
WRITE ?20," for ",ONCONM
+7 IF '$DATA(ONCONM)
DO PAT
if Y<0
GOTO EX
FA SET DA=ONCOD0
SET DR="[ONCO FOLL ATTEMPT]"
SET DIE="^ONCO(160,"
SET L=0
SET FG=0
WRITE !!
DO ^DIE
if $DATA(Y)'=0
GOTO EX
if '$DATA(D1)
GOTO EX
IF 'FG&'($PIECE($GET(^ONCO(160,D0,"A",D1,0)),U,6))
GOTO DEL
+1 SET XX=^ONCO(160,ONCOD0,"A",ONCOD1,0)
IF $PIECE(XX,U,2)=3&($PIECE(XX,U,4)=8)
SET ONCOC0=$PIECE(XX,U,3)
WRITE !!?5,"Generate Letter...!!"
DO LET^ONCOFUP
KILL ONCOC0
GOTO ATM
+2 if $GET(XRS)'=1
GOTO SA
WRITE !!?10,"Complete Follow-up for Successful Contact!!",!
if XTY=3
GOTO DIE
FOL KILL DXS
SET DA(1)=ONCOD0
SET DIC(0)="LZ"
SET (DIE,DIC)="^ONCO(160,"_DA(1)_",""F"","
SET DLAYGO=160
SET X=XDT
IF '$DATA(^ONCO(160,DA(1),"F"))
SET ^ONCO(160,DA(1),"F",0)="^160.04DAI^^"
+1 DO ^DIC
SET DIE=DIE
SET DA=+Y
if Y<0
GOTO EX
+2 ;DEVELOPERS NOTE: For consistent functionality, the following line
+3 ;must be identical to the 160.04 DR string in the input template
+4 ;ONCO FOLLOWUP.
FOLDR SET DR="S ONCOD1=DA;.01;S LC=X;1;S VS=X;3;S:VS=0 Y=""@999"";4;6//^S X=""Chart requisition"";S NF=X S:X'=5 Y=""@1000"",UF="""";7;S UF=X;S Y=""@1000"";@999;4////8;6////9;S NF=9;@1000;5;8////1;D TEMP451^ONCOAIS;S FG=1;"
+1 SET FG=0
DO ^DIE
if FG
GOTO UPDAT
IF 'FG
SET ONCOVS=""
DO UPOUT
GOTO ATM
+2 ;
DIE KILL DXS
SET ONCOSTAT=1
SET DA=ONCOD0
+1 SET DR="[ONCO FOLLOWUP]"
+2 SET DIE="^ONCO(160,"
SET FG=0
WRITE !!
DO ^DIE
IF 'FG
SET ONCOVS=""
GOTO UPOUT
+3 ;
UPDAT SET D0=ONCOD0
KILL DXS,DIOT
DO LST^ONCODLF
DO UPD^ONCOCRF
+1 WRITE !,?5,"**********Following fields have been updated********",!
+2 NEW Y
KILL DIQ,ONC
SET DIC="^ONCO(160,"
SET DR=".01;16;15;15.2"
SET DA=ONCOD0
SET DIQ="ONC"
+3 DO EN^DIQ1
WRITE !
+4 WRITE !?2,"Name..: ",ONC(160,ONCOD0,.01)
+5 WRITE ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
+6 WRITE !?2,"Status: ",ONC(160,ONCOD0,15)
+7 WRITE ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
+8 KILL DIR
SET DIR("A")=" DATA OK"
SET DIR("B")="Yes"
SET DIR(0)="Y"
WRITE !!
+9 DO ^DIR
if (Y=U)!(Y="")
QUIT
if 'Y
GOTO DIE
if ONCOVS
GOTO SA
DO DEAD^ONCOFDP
KILL ONCONM
GOTO ATM
+10 ;
UPOUT ;UPARROW out-check before deleting
+1 if '$DATA(ONCOD1)
QUIT
if '$DATA(^ONCO(160,ONCOD0,"F",ONCOD1,0))
QUIT
if $PIECE(^(0),U,8)=1
QUIT
DO DEL^ONCOAIF
GOTO ATM
+2 QUIT
+3 ;
DEL ;delete entry
+1 if '$DATA(ONCOD1)
QUIT
SET DA(1)=ONCOD0
SET DA=ONCOD1
SET DIK="^ONCO(160,"_DA(1)_",""A"","
DO ^DIK
+2 if $DATA(^ONCO(160,ONCOD0,"A",ONCOD1,0))
WRITE "*",$PIECE(^(0),U,6)
WRITE !!,?10,"*********************ENTRY DELETED*************************",!!
+3 GOTO EX
IN ;
NAM DO HD
WRITE !!
SET DIC="^ONCO(160,"
SET DIC(0)="AEQMZ"
SET DIC("A")=" Enter Patient name: "
DO ^DIC
if Y<0
GOTO EX
SET (ONCOD0,D0)=+Y
T KILL IO("Q")
SET %ZIS="Q"
WRITE !!
DO ^%ZIS
IF POP
SET ONCOUT=""
GOTO NAM
+1 IF '$DATA(IO("Q"))
DO TSK^ONCOFUL
GOTO EX
+2 SET ZTRTN="TSK^ONCOFUL"
SET ZTSAVE("ONCOD0")=""
SET ZTDESC="ONCOLOGY PATIENT INQUIRY"
DO ^%ZTLOAD
GOTO EX
+3 ;
TSK ;Task for Patient Inquiry
DI USE IO
DO HD
SET D0=ONCOD0
+1 KILL DIQ,ONC
SET DIC="^ONCO(160,"
SET DR=".01;16;15;15.2"
SET DA=ONCOD0
SET DIQ="ONC"
+2 DO EN^DIQ1
WRITE !
+3 WRITE !?2,"Name..: ",ONC(160,ONCOD0,.01)
+4 WRITE ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
+5 WRITE !?2,"Status: ",ONC(160,ONCOD0,15)
+6 WRITE ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
+7 DO SUM^ONCOAIF
DO LST^ONCODLF
+8 DO ^%ZISC
+9 QUIT
+10 ;
HD WRITE @IOF,!!!?15,"********** Patient Follow-up Inquiry ***********",!
+1 QUIT
EX ;EXIT ROUTINE
+1 KILL DA,D0,D1,DI,DIC,DIC1,DIE,DIK,ONCOD0,ONCOD1,ONCOVS,ONCONM,ONCOPAT,ONCOVP,%ZISOS
+2 KILL S,F0,FIL,GLR,J,LN,L,LA,NM,OD,OS,OF,%Y,ABS,AC,P,D,DN,DXS,DIYS,DN,ZZL,DIE,DR,ONCON,ONCOX
+3 QUIT
