source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOFLF.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1ONCOFLF ;Hines OIFO/GWB - FOLLOWUP LETTER FUNCTIONS ;11/1/93
2 ;;2.11;ONCOLOGY;**5,6,11,36,37**;Mar 07, 1995
3 ;
4AED ;Edit followup letters - FOLLOW-UP FORM LETTER file (165.1)
5 W !!
6 S (DIC,DLAYGO)="^ONCO(165.1,"
7 S DIC("A")=" Select letter to Add/Edit: ",DIC(0)="AELQZ",D="B"
8 D IX^DIC G EX:Y<0
9 S DA=+Y,DIE=DIC,DR="[ONCO FOLL ADD/EDIT LETTER]" K DC
10 S DIA(1)=+Y,DIA=DIC,DIA("P")="165.1" D ^DIE G AED
11 ;
12HP ;HELP on Patient's contacts
13 K DIC,DXS,DIOT D ^ONCOXPC W !
14 Q
15 ;
16UP ;Update Contact File (Maintain)
17 W @IOF,!!?15,"*************** UPDATE CONTACT FILE ***************",!!
18 K DIR S DIR("A")=" Select function",DIR(0)="SO^1:Add/Edit;2:Delete;3:Print;4:Cleanup;5:Exit" D ^DIR G EX:(Y=U)!(Y="") S OP=Y G @Y
191 ;Edit
20 W !! S (DIC,DIE)="^ONCO(165,",DIC(0)="AELMQZ",DLAYGO=165 D ^DIC G UP:Y=-1 S DA=+Y
21 W !! S DR="[ONCO UPDATE CONTACT]" D ^DIE G UP:$D(Y)'=0,1
22 ;
232 ;Delete
24 W !!!?10,"You may only delete entries which are not 'pointed to'"
25 W !?10,"by other files. If you need to delete these entries, either"
26 W !?10,"edit them, or delete them from Oncology Patient/Primary first.",!!
27 S DIC="^ONCO(165,",DIC(0)="AEZQ" D ^DIC G EX:Y<0 W !!?5,"Checking cross-references..." I $D(^ONCO(165,"ACP",+Y)) W ?40,"CANNOT DELETE!!" G 2
28 S DA=+Y,DIK=DIC W !!?14,"Deleting Contact..." D ^DIK G 2
293 ;Print
30 K DIR S DIR("A")="Type of List",DIR(0)="SO^A:Alphabetic;T:By Type" D ^DIR G EX:(Y[U)!(Y="") G @Y
31 G EX:(Y=U)!(Y="") W !! G @Y
32A W !!?10,"I will print an Alphabetic List of Contacts",!!
33 S BY="[ONCO CONTACT LIST-A]",L=0 D PRT G EX
34T S BY="[ONCO CONTACT LIST-T]",L=0 D PRT G EX
35PRT S DIC="^ONCO(165,",L=0 D EN1^DIP Q
36 ;
374 ;Cleanout unused contacts dead patients
38 W @IOF,?15,"************ Cleanout Unused Contacts ***********",!!
39 G DAC^ONCOFDP
40 ;
415 ;Exit option
42EX ;EXIT ROUTINE
43 K DIC,DIA,DIE,DIR,DA,DR,FIEN,LIEN,NEWIEN,TMP,%X,%Y,%ZISOS,J,OP,BY,L
44 Q
45 ;
46EEACOS ;Enter/Edit FACILITY file (160.19)
47 W !
48 W !,?3,"E Edit an existing entry"
49 W !,?3,"A Add a new entry"
50 W ! K DIR
51 S DIR(0)="FAO^1:1",DIR("A")="Select Enter/Edit Facility file Option: "
52 S DIR("?")=" Enter 'E' to edit an existing FACILITY or 'A' to add a new FACILITY"
53 D ^DIR
54 I $D(DIRUT) G EX
55 I "AE"'[Y G EEACOS
56 I Y="A" S ADDED=0 D ADD G EX:ADDED=0 G EEACOS:ADDED=1
57 I Y="E" D EDIT G EX
58EDIT ;
59 W ! S (DIC,DIE)="^ONCO(160.19,",DIC(0)="AELMQZ",DLAYGO=160.19 D ^DIC
60 Q:Y=-1
61 S DA=+Y
62 W ! S DR=".01;.02;.03;.04" D ^DIE
63 G EDIT
64 Q
65ADD ;
66 S FIEN=$O(^ONCO(160.19,"B",6999000,"")) I FIEN="" S NEWIEN=6999000
67 I FIEN'="" S LIEN=6998999 F X=0:0 S LIEN=$O(^ONCO(160.19,"B",LIEN)) Q:LIEN=9999999 S TMP=LIEN
68 I $G(TMP) S NEWIEN=TMP+1
69 W !!,"NEXT AVAILABLE LOCAL FIN NUMBER IS ",NEWIEN,"."
70 W !
71 K DIR
72 S DIR(0)="Y",DIR("A")="Do you want to add a new entry",DIR("B")="NO"
73 D ^DIR I $D(DIRUT)!(Y=0) Q
74 K DD,DO S DIC="^ONCO(160.19,",DIC(0)="L",X=NEWIEN D FILE^DICN
75 W ! K DIE S DIE="^ONCO(160.19,",DA=+Y,DR=".01;.02;.03;.04" D ^DIE
76 S ADDED=1
77 Q
78 ;
79HELP ;XECUTABLE help to display the next available local number to add a new
80 ;entry to the FACILITY file (160.19)
81 S FIEN=$O(^ONCO(160.19,"B",6999000,"")) I FIEN="" S NEWIEN=6999000
82 I FIEN'="" S LIEN=6998999 F X=0:0 S LIEN=$O(^ONCO(160.19,"B",LIEN)) Q:LIEN=9999999 S TMP=LIEN
83 I $G(TMP) S NEWIEN=TMP+1
84 I $G(DI)=6 D
85 .W !?3,"Identifies the facility that referred the patient to the"
86 .W !?3,"reporting facility."
87 I $G(DI)=7 D
88 .W !?3,"Identifies the facility to which the patient was referred for"
89 .W !?3,"care after discharge from the reporting facility."
90 W !
91 W !?3,"If you wish to add a new facility, enter either the 7-digit"
92 W !?3,"(6020009-6953290) or 8-digit (10000000+) assigned COC FIN"
93 W !?3,"number."
94 W !
95 W !?3,"If the new facility does not have an assigned COC FIN number,"
96 W !?3,"use the next available local FIN number.",!
97 W !?3,"THE NEXT AVAILABLE LOCAL FIN NUMBER IS ",NEWIEN,".",!
98 Q
Note: See TracBrowser for help on using the repository browser.