source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOFUM.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.1 KB
RevLine 
[613]1ONCOFUM ;Hines OIFO/GWB - ADD FOLLOW-UP CONTACT DATA; 10/1/93
2 ;;2.11;ONCOLOGY;**11,45**;Mar 07, 1995
3 ;
4AC ;Add contacts from PATIENT (2) information
5 S VP=ONCOVP,FIL=$P(VP,";",2),DFN=$P(VP,";"),GLR="^"_FIL_DFN_","
6 S X=$P(@(GLR_"0)"),U)
7 S LN=$P(X,",")
8 S DIC="^ONCO(165,",DIC(0)="Z" D ^DIC
9 S CP0=+Y G CKP:+Y>0
10 S DIC(0)="ZL" D FILE^DICN S (DA,CP0)=+Y
11PT S X11=$G(@(GLR_".11)"))
12 S X13=$G(@(GLR_".13)"))
13 S ZIP=$P(X11,U,6),ZP=$O(^VIC(5.11,"B",ZIP_" ",0))
14 S XX11=$P(X11,U,1,3)_"^^^^^^"_ZP
15 S $P(^ONCO(165,CP0,0),U,2)=1,^(.11)=XX11,^(.13)=X13
16 ;
17CKP ;Check ONCOLOGY PATIENT (160) file
18 I '$D(^ONCO(160,ONCOD0,"C")) S ^ONCO(160,ONCOD0,"C",0)="^160.03S^0^0"
19 G:FIL["LRT" PTCONT
20 ;
21K1 G K2:$D(^ONCO(160,ONCOD0,"C","B","NOK"))
22 S X21=$G(^DPT(DFN,.21)) G K2:X21=""
23 F J=1,2,8,9,10 S ONCOX(J)=$P(X21,U,J)
24 S ZIP=ONCOX(8),ZP=$O(^VIC(5.11,"B",ONCOX(8)_" ",0))
25 S XX21=$P(X21,U,3,5)_"^^^^^^"_ZP
26 S X=ONCOX(1),X=$P(X," ",2)_","_$P(X," "),X=$S($P(X,",")="":LN_X,1:X)
27 S (DIC,DIE)="^ONCO(165,",DIC(0)="Z" D ^DIC
28 S CK0=+Y G SK1:+Y>0 S DIC(0)="ZL" D FILE^DICN S (DA,CK0)=+Y
29 S DR="1///^S X=3;2///^S X=ONCOX(2);" D ^DIE S ^ONCO(165,CK0,.11)=XX21,^(.13)=ONCOX(9)
30 I $P(XX21,U)=""&(ONCOX(10)="Y") S ^ONCO(165,CK0,.11)=^ONCO(165,CP0,.11)
31SK1 S DA(1)=ONCOD0,(DIC,DIE)="^ONCO(160,"_DA(1)_",""C"",",X="NOK" D FILE^DICN S DA=+Y,DR="1///^S X=CK0;" D ^DIE
32 ;
33K2 G DE:$D(^ONCO(160,ONCOD0,"C","B","KIN")) S X211=$G(^DPT(DFN,.211)) G DE:X211="" F J=1,2,8,9,10 S ONCOX(J)=$P(X211,U,J)
34 S ZIP=ONCOX(8),ZP=$O(^VIC(5.11,"B",ONCOX(8)_" ",0)),XX211=$P(X211,U,3,5)_"^^^^^^"_ZP,X=ONCOX(1),X=$P(X," ",2)_","_$P(X," ")
35 S (DIC,DIE)="^ONCO(165,",DIC(0)="Z" D ^DIC S CK2=+Y G SK2:+Y>0 S DIC(0)="ZL" D FILE^DICN S (DA,CK2)=+Y
36 S DR="1///^S X=3;2///^S X=ONCOX(2);" D ^DIE S ^ONCO(165,CK2,.11)=XX211,^(.13)=ONCOX(9)
37 I $P(XX211,U)=""&(ONCOX(10)="Y") S ^ONCO(165,CK2,.11)=^ONCO(165,CP0,.11)
38 ;
39SK2 S DA(1)=ONCOD0,(DIC,DIE)="^ONCO(160,"_DA(1)_",""C"",",X="KIN" D FILE^DICN S DA=+Y,DR="1///^S X=CK2;" D ^DIE
40 ;
41DE ;Designee (Guardian)
42 G EX:$D(^ONCO(160,ONCOD0,"C","B","GR")) S X34=$G(^DPT(DFN,.34)) G EX:X34="" F J=1,2,8,9,10 S ONCOX(J)=$P(X34,U,J)
43 S ZIP=ONCOX(8),ZP=$O(^VIC(5.11,"B",ONCOX(8)_" ",0)),XX34=$P(X34,U,3,5)_"^^^^^^"_ZP,X=ONCOX(1),X=$P(X," ",2)_","_$P(X," "),X=$S($P(X,",")="":LN_X,1:X)
44 S (DIC,DIE)="^ONCO(165,",DIC(0)="Z" D ^DIC S GR0=+Y G SDE:+Y>0 S DIC(0)="ZL" D FILE^DICN S (DA,GR0)=+Y
45 S DR="1///^S X=3;2///^S X=ONCOX(2);" D ^DIE S ^ONCO(165,GR0,.11)=XX34,^(.13)=ONCOX(9)
46 I $P(XX34,U)=""&(ONCOX(10)="Y") S ^ONCO(165,GR0,.11)=^ONCO(165,CP0,.11)
47 ;
48SDE S DA(1)=ONCOD0,(DIC,DIE)="^ONCO(160,"_DA(1)_",""C"",",X="GR" D FILE^DICN S DA=+Y,DR="1///^S X=GR0;" D ^DIE
49 ;
50PTCONT G EX:$D(^ONCO(160,ONCOD0,"C","B","PT"))
51 K DA
52 S DA(1)=ONCOD0
53 S (DIE,DIC,DLAYGO)="^ONCO(160,"_DA(1)_",""C"","
54 S DIC(0)="ZL",X="PT" D FILE^DICN S (DA,XD1)=+Y
55 S DR="1///^S X=CP0;" D ^DIE G EX
56 ;
57TYP ;Type contact help
58 W !?5,"Patient refers to this patient (him/herself)",!
59 Q
60 ;
61NAM ;EXTENDED HELP for CONTACT NAME (160.03,1)
62 W !?3,"To change the contact, change the CONTACT NAME above."
63 W !?3,"To edit the contact details, edit the CONTACT entry in"
64 W !?3,"the ONCOLOGY CONTACT File."
65 W !
66 Q
67 ;
68EX ;EXIT ROUTINE
69 K DIC,DIE,DIK,DR,DIC
70 Q
Note: See TracBrowser for help on using the repository browser.