source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOFUL.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1ONCOFUL ;Hines OIFO/GWB - FOLLOWUP PROCEDURES ;07/12/00
2 ;;2.11;ONCOLOGY;**22,23,25,26,29**;Mar 07, 1995
3PAT ;Select patient
4 W !
5 S DIC="^ONCO(160,",DIC("A")=" Select Patient: ",DIC(0)="AEMQZ" D ^DIC
6 Q:(Y<0)!(+Y[U)
7 S (ONCOPAT,ONCOD0,DA)=+Y,X=Y(0,0),ONCOVP=$P(Y,U,2)
8 S X=$P(X,",",2)_" "_$P(X,","),ONCONM=$$LCASE^ONCOU(X)
9 Q
10AP K ONCOD0,ONCOVP,ONCONM
11DCL ;DISPLAY CONTACT LIST
12 W @IOF,!!,?20,"********* DISPLAY CONTACTS **********",!!
13 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)
14 S LN=$P(X,","),X=$P(X,",",2)_" "_LN S ONCONM=$$LCASE^ONCOU(X)
15FI S FIL=$P(ONCOVP,";",2),DFN=$P(ONCOVP,";"),GLR=U_FIL_DFN_",",X=$P(@(GLR_"0)"),U)
16X K D1 S D0=ONCOD0,D1=$O(^ONCO(160,D0,"C","B","PT",0)) I D1="" D ^ONCOFUM
17ADC ;ADD CONTACTS
18 K DXS,DIOT S D0=ONCOD0 D ^ONCOXCL
19EC W !!?20,"********** ADD/EDIT CONTACTS **********",!! W:$D(ONCONM) ?20,"for: ",ONCONM,!!
20 S F0=0,DA=ONCOD0,DIE="^ONCO(160,",DR="[ONCO FOLL-ADD CONTACT]" D ^DIE ;G EX:'F0,EX:$D(Y)=0,DCL
21SA 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
22 ;
23ATM ;[AF Attempt a Follow-up] [ONCO FOLL-ATTEMPT FOLLOWUP]
24 N ONCDUZ,ONCDT
25 S ONCDUZ=DUZ,ONCDT=DT
26 W @IOF,!!?20,"********** ATTEMPT A FOLLOW-UP **********",!!
27 K ONCOVS,VS,DIC,DIE
28 I '$D(ONCOD0) D PAT G EX:Y<0
29 E W:$D(ONCONM) ?20," for ",ONCONM
30 I '$D(ONCONM) D PAT G EX:Y<0
31FA 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
32 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
33 G SA:$G(XRS)'=1 W !!?10,"Complete Follow-up for Successful Contact!!",! G DIE:XTY=3
34FOL 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^^"
35 D ^DIC S DIE=DIE,DA=+Y G EX:Y<0
36 ;DEVELOPERS NOTE: For consistent functionality, the following line
37 ;must be identical to the 160.04 DR string in the input template
38 ;ONCO FOLLOWUP.
39FOLDR 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;"
40 S FG=0 D ^DIE G UPDAT:FG I 'FG S ONCOVS="" D UPOUT G ATM
41 ;
42DIE K DXS S ONCOSTAT=1,DA=ONCOD0
43 S DR="[ONCO FOLLOWUP]"
44 S DIE="^ONCO(160,",FG=0 W !! D ^DIE I 'FG S ONCOVS="" G UPOUT
45 ;
46UPDAT S D0=ONCOD0 K DXS,DIOT D LST^ONCODLF,UPD^ONCOCRF
47 W !,?5,"**********Following fields have been updated********",!
48 N Y K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
49 D EN^DIQ1 W !
50 W !?2,"Name..: ",ONC(160,ONCOD0,.01)
51 W ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
52 W !?2,"Status: ",ONC(160,ONCOD0,15)
53 W ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
54 K DIR S DIR("A")=" DATA OK",DIR("B")="Yes",DIR(0)="Y" W !!
55 D ^DIR Q:(Y=U)!(Y="") G DIE:'Y,SA:ONCOVS D DEAD^ONCOFDP K ONCONM G ATM
56 ;
57UPOUT ;UPARROW out-check before deleting
58 Q:'$D(ONCOD1) Q:'$D(^ONCO(160,ONCOD0,"F",ONCOD1,0)) Q:$P(^(0),U,8)=1 D DEL^ONCOAIF G ATM
59 Q
60 ;
61DEL ;delete entry
62 Q:'$D(ONCOD1) S DA(1)=ONCOD0,DA=ONCOD1,DIK="^ONCO(160,"_DA(1)_",""A""," D ^DIK
63 W:$D(^ONCO(160,ONCOD0,"A",ONCOD1,0)) "*",$P(^(0),U,6) W !!,?10,"*********************ENTRY DELETED*************************",!!
64 G EX
65IN ;
66NAM 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
67T K IO("Q") S %ZIS="Q" W !! D ^%ZIS I POP S ONCOUT="" G NAM
68 I '$D(IO("Q")) D TSK^ONCOFUL G EX
69 S ZTRTN="TSK^ONCOFUL",ZTSAVE("ONCOD0")="",ZTDESC="ONCOLOGY PATIENT INQUIRY" D ^%ZTLOAD G EX
70 ;
71TSK ;Task for Patient Inquiry
72DI U IO D HD S D0=ONCOD0
73 K DIQ,ONC S DIC="^ONCO(160,",DR=".01;16;15;15.2",DA=ONCOD0,DIQ="ONC"
74 D EN^DIQ1 W !
75 W !?2,"Name..: ",ONC(160,ONCOD0,.01)
76 W ?35,"Date Last Contact: ",ONC(160,ONCOD0,16)
77 W !?2,"Status: ",ONC(160,ONCOD0,15)
78 W ?35,"Follow-Up Status.: ",ONC(160,ONCOD0,15.2)
79 D SUM^ONCOAIF,LST^ONCODLF
80 D ^%ZISC
81 Q
82 ;
83HD W @IOF,!!!?15,"********** Patient Follow-up Inquiry ***********",!
84 Q
85EX ;EXIT ROUTINE
86 K DA,D0,D1,DI,DIC,DIC1,DIE,DIK,ONCOD0,ONCOD1,ONCOVS,ONCONM,ONCOPAT,ONCOVP,%ZISOS
87 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
88 Q
Note: See TracBrowser for help on using the repository browser.