- 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 Feb 18, 2025@23:51:33 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