ONCOFUM ;Hines OIFO/GWB -FOLLOW-UP CONTACT (160,420) ;06/23/10
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
AC ;Add patient to ONCOLOGY CONTACT file (165) using ^DPT(D0,.11) and
;^DPT(D0,.13) node data from PATIENT file (2)
S FIL=$P(ONCOVP,";",2),DFN=$P(ONCOVP,";",1),GLR="^"_FIL_DFN_","
S X=$P(@(GLR_"0)"),U,1)
S DIC="^ONCO(165,",DIC(0)="Z" D ^DIC
S CP0=+Y
I +Y>0 G CKP
K DO S DIC(0)="ZL" D FILE^DICN S (DA,CP0)=+Y
S X11=$G(@(GLR_".11)"))
S X13=$G(@(GLR_".13)"))
S CITY=$P(X11,U,4)
S STATE=$P(X11,U,5)
S ZIP=$P(X11,U,6)
S XX11=$P(X11,U,1,3)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
S $P(^ONCO(165,CP0,0),U,2)=1,^(.11)=XX11,^(.13)=X13
;
CKP G:FIL["LRT" PTCONT
;
K1 ;Add NOK (Next of Kin) to ONCOLOGY CONTACT file (165) using
;^DPT(D0,.21) node data from PATIENT file (2)
G K2:$D(^ONCO(160,ONCOD0,"C","B","NOK"))
S X21=$G(^DPT(DFN,.21)) G K2:X21=""
F J=1,6,7,8,9,10 S ONCOX(J)=$P(X21,U,J)
S CITY=ONCOX(6)
S STATE=ONCOX(7)
S ZIP=ONCOX(8)
S XX21=$P(X21,U,3,5)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
S X=ONCOX(1)
S (DIC,DIE)="^ONCO(165,",DIC(0)="Z" D ^DIC
S CK0=+Y
G SK1:+Y>0
K DO S DIC(0)="ZL" D FILE^DICN S (DA,CK0)=+Y
S DR="1///^S X=3"
D ^DIE S ^ONCO(165,CK0,.11)=XX21,^(.13)=ONCOX(9)
I ($P(XX21,U,1)="")&(ONCOX(10)="Y") D
.S ^ONCO(165,CK0,.11)=^ONCO(165,CP0,.11)
;
SK1 ;Add NOK (Next of Kin) TYPE OF FOLLOW-UP CONTACT (160,420)
S DA(1)=ONCOD0,(DIC,DIE)="^ONCO(160,"_DA(1)_",""C"",",X="NOK"
K DO D FILE^DICN S DA=+Y,DR="1///^S X=CK0" D ^DIE
;
K2 ;Add KIN (Other Kin) to ONCOLOGY CONTACT file (165) using ^DPT(D0,.211)
;node data from PATIENT file (2)
G DE:$D(^ONCO(160,ONCOD0,"C","B","KIN"))
S X211=$G(^DPT(DFN,.211)) G DE:X211=""
F J=1,2,6,7,8,9,10 S ONCOX(J)=$P(X211,U,J)
S CITY=ONCOX(6)
S STATE=ONCOX(7)
S ZIP=ONCOX(8)
S XX211=$P(X211,U,3,5)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
S X=ONCOX(1)
S (DIC,DIE)="^ONCO(165,",DIC(0)="Z" D ^DIC
S CK2=+Y G SK2:+Y>0
K DO S DIC(0)="ZL" D FILE^DICN S (DA,CK2)=+Y
S DR="1///^S X=3;2///^S X=ONCOX(2)" D ^DIE
S ^ONCO(165,CK2,.11)=XX211,^(.13)=ONCOX(9)
I ($P(XX211,U)="")&(ONCOX(10)="Y") D
.S ^ONCO(165,CK2,.11)=^ONCO(165,CP0,.11)
;
SK2 ;Add KIN (Other Kin) TYPE OF FOLLOW-UP CONTACT (160,420)
S DA(1)=ONCOD0,(DIC,DIE)="^ONCO(160,"_DA(1)_",""C"",",X="KIN"
K DO D FILE^DICN S DA=+Y,DR="1///^S X=CK2;" D ^DIE
;
DE ;Add GR (Guardian) to ONCOLOGY CONTACT file (165) using ^DPT(D0,.34)
;node data from PATIENT file (2)
G EX:$D(^ONCO(160,ONCOD0,"C","B","GR"))
S X34=$G(^DPT(DFN,.34)) G EX:X34=""
F J=1,6,7,8,9,10 S ONCOX(J)=$P(X34,U,J)
S CITY=ONCOX(6)
S STATE=ONCOX(7)
S ZIP=ONCOX(8)
S XX34=$P(X34,U,3,5)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
S X=ONCOX(1)
S (DIC,DIE)="^ONCO(165,",DIC(0)="Z" D ^DIC
S GR0=+Y G SDE:+Y>0
K DO S DIC(0)="ZL" D FILE^DICN S (DA,GR0)=+Y
S DR="1///^S X=3" D ^DIE S ^ONCO(165,GR0,.11)=XX34,^(.13)=ONCOX(9)
I ($P(XX34,U)="")&(ONCOX(10)="Y") D
.S ^ONCO(165,GR0,.11)=^ONCO(165,CP0,.11)
;
SDE ;Add GR (Guardian) TYPE OF FOLLOW-UP CONTACT (160,420)
S DA(1)=ONCOD0,(DIC,DIE)="^ONCO(160,"_DA(1)_",""C"",",X="GR"
K DO D FILE^DICN S DA=+Y,DR="1///^S X=GR0;" D ^DIE
;
PTCONT ;Add PT (Patient) TYPE OF FOLLOW-UP CONTACT (160,420)
G EX:$D(^ONCO(160,ONCOD0,"C","B","PT"))
S DA(1)=ONCOD0,(DIE,DIC)="^ONCO(160,"_DA(1)_",""C"",",X="PT"
K DO D FILE^DICN S DA=+Y,DR="1///^S X=CP0;" D ^DIE
G EX
;
TYP ;TYPE OF FOLLOW-UP CONTACT (160.03,.01) EXECUTABLE HELP
W !?5,"PT (Patient) refers to this patient.",!
Q
;
NAM ;CONTACT NAME (160.03,1) EXECUTABLE HELP
W !?3,"To change the contact, change the CONTACT NAME."
W !?3,"To edit the contact details, edit the CONTACT"
W !?3,"entry in the ONCOLOGY CONTACT File.",!
Q
;
EX ;Exit
K CITY,CK0,CK2,CP0,DA,DFN,DIC,DIE,DR,FIL,GLR,GR0,J,ONCOVP,ONCOX,STATE
K X,X11,X13,X21,X211,X34,XX11,XX21,XX211,XX34,Y,ZIP
Q
;
CLEANUP ;Cleanup
K ONCOD0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOFUM 3880 printed Dec 13, 2024@02:25:05 Page 2
ONCOFUM ;Hines OIFO/GWB -FOLLOW-UP CONTACT (160,420) ;06/23/10
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
AC ;Add patient to ONCOLOGY CONTACT file (165) using ^DPT(D0,.11) and
+1 ;^DPT(D0,.13) node data from PATIENT file (2)
+2 SET FIL=$PIECE(ONCOVP,";",2)
SET DFN=$PIECE(ONCOVP,";",1)
SET GLR="^"_FIL_DFN_","
+3 SET X=$PIECE(@(GLR_"0)"),U,1)
+4 SET DIC="^ONCO(165,"
SET DIC(0)="Z"
DO ^DIC
+5 SET CP0=+Y
+6 IF +Y>0
GOTO CKP
+7 KILL DO
SET DIC(0)="ZL"
DO FILE^DICN
SET (DA,CP0)=+Y
+8 SET X11=$GET(@(GLR_".11)"))
+9 SET X13=$GET(@(GLR_".13)"))
+10 SET CITY=$PIECE(X11,U,4)
+11 SET STATE=$PIECE(X11,U,5)
+12 SET ZIP=$PIECE(X11,U,6)
+13 SET XX11=$PIECE(X11,U,1,3)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
+14 SET $PIECE(^ONCO(165,CP0,0),U,2)=1
SET ^(.11)=XX11
SET ^(.13)=X13
+15 ;
CKP if FIL["LRT"
GOTO PTCONT
+1 ;
K1 ;Add NOK (Next of Kin) to ONCOLOGY CONTACT file (165) using
+1 ;^DPT(D0,.21) node data from PATIENT file (2)
+2 if $DATA(^ONCO(160,ONCOD0,"C","B","NOK"))
GOTO K2
+3 SET X21=$GET(^DPT(DFN,.21))
if X21=""
GOTO K2
+4 FOR J=1,6,7,8,9,10
SET ONCOX(J)=$PIECE(X21,U,J)
+5 SET CITY=ONCOX(6)
+6 SET STATE=ONCOX(7)
+7 SET ZIP=ONCOX(8)
+8 SET XX21=$PIECE(X21,U,3,5)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
+9 SET X=ONCOX(1)
+10 SET (DIC,DIE)="^ONCO(165,"
SET DIC(0)="Z"
DO ^DIC
+11 SET CK0=+Y
+12 if +Y>0
GOTO SK1
+13 KILL DO
SET DIC(0)="ZL"
DO FILE^DICN
SET (DA,CK0)=+Y
+14 SET DR="1///^S X=3"
+15 DO ^DIE
SET ^ONCO(165,CK0,.11)=XX21
SET ^(.13)=ONCOX(9)
+16 IF ($PIECE(XX21,U,1)="")&(ONCOX(10)="Y")
Begin DoDot:1
+17 SET ^ONCO(165,CK0,.11)=^ONCO(165,CP0,.11)
End DoDot:1
+18 ;
SK1 ;Add NOK (Next of Kin) TYPE OF FOLLOW-UP CONTACT (160,420)
+1 SET DA(1)=ONCOD0
SET (DIC,DIE)="^ONCO(160,"_DA(1)_",""C"","
SET X="NOK"
+2 KILL DO
DO FILE^DICN
SET DA=+Y
SET DR="1///^S X=CK0"
DO ^DIE
+3 ;
K2 ;Add KIN (Other Kin) to ONCOLOGY CONTACT file (165) using ^DPT(D0,.211)
+1 ;node data from PATIENT file (2)
+2 if $DATA(^ONCO(160,ONCOD0,"C","B","KIN"))
GOTO DE
+3 SET X211=$GET(^DPT(DFN,.211))
if X211=""
GOTO DE
+4 FOR J=1,2,6,7,8,9,10
SET ONCOX(J)=$PIECE(X211,U,J)
+5 SET CITY=ONCOX(6)
+6 SET STATE=ONCOX(7)
+7 SET ZIP=ONCOX(8)
+8 SET XX211=$PIECE(X211,U,3,5)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
+9 SET X=ONCOX(1)
+10 SET (DIC,DIE)="^ONCO(165,"
SET DIC(0)="Z"
DO ^DIC
+11 SET CK2=+Y
if +Y>0
GOTO SK2
+12 KILL DO
SET DIC(0)="ZL"
DO FILE^DICN
SET (DA,CK2)=+Y
+13 SET DR="1///^S X=3;2///^S X=ONCOX(2)"
DO ^DIE
+14 SET ^ONCO(165,CK2,.11)=XX211
SET ^(.13)=ONCOX(9)
+15 IF ($PIECE(XX211,U)="")&(ONCOX(10)="Y")
Begin DoDot:1
+16 SET ^ONCO(165,CK2,.11)=^ONCO(165,CP0,.11)
End DoDot:1
+17 ;
SK2 ;Add KIN (Other Kin) TYPE OF FOLLOW-UP CONTACT (160,420)
+1 SET DA(1)=ONCOD0
SET (DIC,DIE)="^ONCO(160,"_DA(1)_",""C"","
SET X="KIN"
+2 KILL DO
DO FILE^DICN
SET DA=+Y
SET DR="1///^S X=CK2;"
DO ^DIE
+3 ;
DE ;Add GR (Guardian) to ONCOLOGY CONTACT file (165) using ^DPT(D0,.34)
+1 ;node data from PATIENT file (2)
+2 if $DATA(^ONCO(160,ONCOD0,"C","B","GR"))
GOTO EX
+3 SET X34=$GET(^DPT(DFN,.34))
if X34=""
GOTO EX
+4 FOR J=1,6,7,8,9,10
SET ONCOX(J)=$PIECE(X34,U,J)
+5 SET CITY=ONCOX(6)
+6 SET STATE=ONCOX(7)
+7 SET ZIP=ONCOX(8)
+8 SET XX34=$PIECE(X34,U,3,5)_"^"_CITY_"^"_STATE_"^^^^"_ZIP
+9 SET X=ONCOX(1)
+10 SET (DIC,DIE)="^ONCO(165,"
SET DIC(0)="Z"
DO ^DIC
+11 SET GR0=+Y
if +Y>0
GOTO SDE
+12 KILL DO
SET DIC(0)="ZL"
DO FILE^DICN
SET (DA,GR0)=+Y
+13 SET DR="1///^S X=3"
DO ^DIE
SET ^ONCO(165,GR0,.11)=XX34
SET ^(.13)=ONCOX(9)
+14 IF ($PIECE(XX34,U)="")&(ONCOX(10)="Y")
Begin DoDot:1
+15 SET ^ONCO(165,GR0,.11)=^ONCO(165,CP0,.11)
End DoDot:1
+16 ;
SDE ;Add GR (Guardian) TYPE OF FOLLOW-UP CONTACT (160,420)
+1 SET DA(1)=ONCOD0
SET (DIC,DIE)="^ONCO(160,"_DA(1)_",""C"","
SET X="GR"
+2 KILL DO
DO FILE^DICN
SET DA=+Y
SET DR="1///^S X=GR0;"
DO ^DIE
+3 ;
PTCONT ;Add PT (Patient) TYPE OF FOLLOW-UP CONTACT (160,420)
+1 if $DATA(^ONCO(160,ONCOD0,"C","B","PT"))
GOTO EX
+2 SET DA(1)=ONCOD0
SET (DIE,DIC)="^ONCO(160,"_DA(1)_",""C"","
SET X="PT"
+3 KILL DO
DO FILE^DICN
SET DA=+Y
SET DR="1///^S X=CP0;"
DO ^DIE
+4 GOTO EX
+5 ;
TYP ;TYPE OF FOLLOW-UP CONTACT (160.03,.01) EXECUTABLE HELP
+1 WRITE !?5,"PT (Patient) refers to this patient.",!
+2 QUIT
+3 ;
NAM ;CONTACT NAME (160.03,1) EXECUTABLE HELP
+1 WRITE !?3,"To change the contact, change the CONTACT NAME."
+2 WRITE !?3,"To edit the contact details, edit the CONTACT"
+3 WRITE !?3,"entry in the ONCOLOGY CONTACT File.",!
+4 QUIT
+5 ;
EX ;Exit
+1 KILL CITY,CK0,CK2,CP0,DA,DFN,DIC,DIE,DR,FIL,GLR,GR0,J,ONCOVP,ONCOX,STATE
+2 KILL X,X11,X13,X21,X211,X34,XX11,XX21,XX211,XX34,Y,ZIP
+3 QUIT
+4 ;
CLEANUP ;Cleanup
+1 KILL ONCOD0
