ONCOFLF ;HINES OIFO/GWB - FOLLOWUP LETTER FUNCTIONS ;11/1/93
;;2.2;ONCOLOGY;**1,17**;Jul 31, 2013;Build 6
;
AED ;[EL Add/Edit Follow-up Letter]
W !
S (DIC,DLAYGO)="^ONCO(165.1,"
S DIC("A")="Select letter to Add/Edit: ",DIC(0)="AELQZ",D="B"
D IX^DIC G EX:Y<0
S DA=+Y,DIE=DIC,DR="[ONCO FOLL ADD/EDIT LETTER]" K DC
S DIA(1)=+Y,DIA=DIC,DIA("P")="165.1" D ^DIE
G AED
;
UP ;[UP Update Contact File]
W @IOF,!?15,"*************** UPDATE CONTACT FILE ***************"
K DIR
S DIR("A")=" Select function"
S DIR(0)="SO^1:Add/Edit;2:Delete;3:Print;4:Cleanup (**> Out of order)"
D ^DIR
G EX:($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) G @Y
;
1 ;Edit
W !
S (DIC,DIE)="^ONCO(165,"
S DIC(0)="AELMQZ"
S DLAYGO=165
D ^DIC G UP:Y=-1 S DA=+Y
W ! S DR="[ONCO UPDATE CONTACT]" D ^DIE G UP:$D(Y)'=0,1
;
2 ;Delete
W !
S DIC="^ONCO(165,"
S DIC(0)="AEZQ"
D ^DIC G EX:Y<0
I ($D(^ONCO(165,"ACP",+Y)))!($D(^ONCO(160,"AC",+Y)))!($D(^ONCO(160,"AE",+Y))) W !!?10,"You may only delete contacts which are not being used." G 2
S DA=+Y,DIK=DIC W !!?10,"Deleting Contact ",Y(0,0) D ^DIK G 2
;
3 ;Print
K DIR
S DIR("A")="Type of List"
S DIR(0)="SO^A:Alphabetic;T:By Type"
D ^DIR
G EX:($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT)) G @Y
;
A ;Alphabetic
S BY="[ONCO CONTACT LIST-A]",L=0
S DIC="^ONCO(165,",L=0 D EN1^DIP
G EX
;
T ;By Type
S BY="[ONCO CONTACT LIST-T]",L=0
S DIC="^ONCO(165,",L=0 D EN1^DIP
G EX
;
4 ;Cleanup
Q
W @IOF,?15,"************ Cleanout Unused Contacts ***********",!!
G DAC^ONCOFDP
;
UPHYCON ;Add/Edit/Update Physician contact
;W @IOF,
W !!!?15,"******* ADD/UPDATE PHYSICIAN CONTACT ***************"
K DIR
S DIR("A")=" Select function"
S DIR(0)="SO^1:Add new physician contact;2:Edit NPI of existing physician contact;3:Delete existing physician contact"
D ^DIR
G EX:($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT))
I Y=1 D ADDPC Q
I Y=2 D EDPC Q
I Y=3 D DELPC Q
Q
;
ADDPC ;
N ONCPHYNM,ONCNPIVL
W ! K DIR S DIR("A")="Enter physician name",DIR(0)="F^3:30" D ^DIR
G EX:($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT))
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S ONCPHYNM=X
I $D(^ONCO(165,"B",ONCPHYNM)) W !,"*** NOTE: '",ONCPHYNM,"' ALREADY IN CONTACT FILE - USE EDIT OPTION" Q
ENTNPI W ! K DIR S DIR("A")="Enter physician NPI",DIR(0)="N"
S DIR("?")=" "
S DIR("?",1)=" Enter the NPI # for the physician contact."
S DIR("?",2)=" If you are unsure of the NPI #, you may use the National Provider"
S DIR("?",3)=" Identifier registry search to look up the NPI #:"
S DIR("?",4)=" https://npiregistry.cms.hhs.gov/search"
D ^DIR
G EX:($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT))
S ONCNPIVL=X
I ONCNPIVL'?10N W !,"NPI MUST BE 10 DIGITS" G ENTNPI
I $D(^ONCO(165,"F",ONCNPIVL)) D
.W !,"NOTE: NPI # '",ONCNPIVL,"' ALREADY ASSIGNED TO THIS CONTACT(S): "
.F IENZZ=0:0 S IENZZ=$O(^ONCO(165,"F",ONCNPIVL,IENZZ)) Q:IENZZ'>0 D
..W !?8,$P($G(^ONCO(165,IENZZ,0)),"^",1)
W !!?6,"Adding to physician contacts:",!,?8,"Name: ",ONCPHYNM," NPI: ",ONCNPIVL
W ! K DIR S DIR("A")="Do you wish to continue",DIR("B")="Y",DIR(0)="Y" D ^DIR
I Y'=1 G UPHYCON
S DIC="^ONCO(165,",DIC(0)="L",X=ONCPHYNM
S DIC("DR")="1///^S X=2;101///^S X=ONCNPIVL"
D FILE^DICN
Q
;
EDPC ;
S DIC="^ONCO(165,",DIC(0)="AEQZM"
S DIC("A")=" Select physician contact name: ",DIC("S")="I $P(^(0),U,2)=2"
D ^DIC K DIC G EX:Y<0
S DA=+Y
S DIE="^ONCO(165,",DIC(0)="AELQMZ"
S DR=".01;101" D ^DIE
Q
;
DELPC ;
W !
S DIC="^ONCO(165,"
S DIC(0)="AEZQ",DIC("S")="I $P(^(0),U,2)=2"
D ^DIC G EX:Y<0
I ($D(^ONCO(165,"ACP",+Y)))!($D(^ONCO(160,"AC",+Y)))!($D(^ONCO(160,"AE",+Y))) W !!?10,"You may only delete contacts which are not being used." G DELPC
S DA=+Y,DIK=DIC W !!?10,"Deleting Contact ",Y(0,0) D ^DIK G DELPC
Q
;
EX ;Exit
K ADDED,BY,D,DA,DIC,DIA,DIE,DIK,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT
K FIEN,L,LIEN,NEWIEN,OP,TMP,X,Y
Q
;
HP ;THE CONTACT (160.06,2) EXECUTABLE HELP
K DIC,DXS,DIOT
D ^ONCOXPC
W !
Q
;
EEACOS ;[AC Enter/Edit Facility file]
W !
W !,?3,"E Edit an existing entry"
W !,?3,"A Add a new entry"
W ! K DIR
S DIR(0)="FAO^1:1",DIR("A")="Select Enter/Edit Facility file Option: "
S DIR("?")=" Enter 'E' to edit an existing FACILITY or 'A' to add a new FACILITY"
D ^DIR
I $D(DIRUT) G EX
I "AE"'[Y G EEACOS
I Y="A" S ADDED=0 D ADD G EX:ADDED=0 G EEACOS:ADDED=1
I Y="E" D EDIT G EX
;
EDIT ;Edit FACILITY file (160.19)
W ! S (DIC,DIE)="^ONCO(160.19,",DIC(0)="AELMQZ",DLAYGO=160.19 D ^DIC
Q:Y=-1
S DA=+Y
W ! S DR=".01;.02;.03;.04;101" D ^DIE
G EDIT
Q
ADD ;Add new FACILITY file (160.19) entry
S FIEN=$O(^ONCO(160.19,"B",6999000,"")) I FIEN="" S NEWIEN=6999000
I FIEN'="" S LIEN=6998999 F X=0:0 S LIEN=$O(^ONCO(160.19,"B",LIEN)) Q:LIEN=9999999 S TMP=LIEN
I $G(TMP) S NEWIEN=TMP+1
W !!,"NEXT AVAILABLE LOCAL FIN NUMBER IS ",NEWIEN,"."
W !
K DIR
S DIR(0)="Y",DIR("A")="Do you want to add a new entry",DIR("B")="NO"
D ^DIR I $D(DIRUT)!(Y=0) Q
K DD,DO
S DIC="^ONCO(160.19,",DIC(0)="L",X=NEWIEN D FILE^DICN K DIC,DLAYGO,DO
W ! K DIE S DIE="^ONCO(160.19,",DA=+Y,DR=".01;.02;.03;.04" D ^DIE
S ADDED=1
Q
;
HELP ;EXCUTABLE HELP to display next available local FACILITY number
S FIEN=$O(^ONCO(160.19,"B",6999000,"")) I FIEN="" S NEWIEN=6999000
I FIEN'="" S LIEN=6998999 F X=0:0 S LIEN=$O(^ONCO(160.19,"B",LIEN)) Q:LIEN=9999999 S TMP=LIEN
I $G(TMP) S NEWIEN=TMP+1
W !
W !?3,"If you wish to add a new facility, enter either the 7-digit"
W !?3,"(6020009-6953290) or 8-digit (10000000+) assigned COC FIN"
W !?3,"number."
W !
W !?3,"If the new facility does not have an assigned COC FIN number,"
W !?3,"use the next available local FIN number.",!
W !?3,"THE NEXT AVAILABLE LOCAL FIN NUMBER IS ",NEWIEN,".",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOFLF 5909 printed Dec 13, 2024@02:25:02 Page 2
ONCOFLF ;HINES OIFO/GWB - FOLLOWUP LETTER FUNCTIONS ;11/1/93
+1 ;;2.2;ONCOLOGY;**1,17**;Jul 31, 2013;Build 6
+2 ;
AED ;[EL Add/Edit Follow-up Letter]
+1 WRITE !
+2 SET (DIC,DLAYGO)="^ONCO(165.1,"
+3 SET DIC("A")="Select letter to Add/Edit: "
SET DIC(0)="AELQZ"
SET D="B"
+4 DO IX^DIC
if Y<0
GOTO EX
+5 SET DA=+Y
SET DIE=DIC
SET DR="[ONCO FOLL ADD/EDIT LETTER]"
KILL DC
+6 SET DIA(1)=+Y
SET DIA=DIC
SET DIA("P")="165.1"
DO ^DIE
+7 GOTO AED
+8 ;
UP ;[UP Update Contact File]
+1 WRITE @IOF,!?15,"*************** UPDATE CONTACT FILE ***************"
+2 KILL DIR
+3 SET DIR("A")=" Select function"
+4 SET DIR(0)="SO^1:Add/Edit;2:Delete;3:Print;4:Cleanup (**> Out of order)"
+5 DO ^DIR
+6 if ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO EX
GOTO @Y
+7 ;
1 ;Edit
+1 WRITE !
+2 SET (DIC,DIE)="^ONCO(165,"
+3 SET DIC(0)="AELMQZ"
+4 SET DLAYGO=165
+5 DO ^DIC
if Y=-1
GOTO UP
SET DA=+Y
+6 WRITE !
SET DR="[ONCO UPDATE CONTACT]"
DO ^DIE
if $DATA(Y)'=0
GOTO UP
GOTO 1
+7 ;
2 ;Delete
+1 WRITE !
+2 SET DIC="^ONCO(165,"
+3 SET DIC(0)="AEZQ"
+4 DO ^DIC
if Y<0
GOTO EX
+5 IF ($DATA(^ONCO(165,"ACP",+Y)))!($DATA(^ONCO(160,"AC",+Y)))!($DATA(^ONCO(160,"AE",+Y)))
WRITE !!?10,"You may only delete contacts which are not being used."
GOTO 2
+6 SET DA=+Y
SET DIK=DIC
WRITE !!?10,"Deleting Contact ",Y(0,0)
DO ^DIK
GOTO 2
+7 ;
3 ;Print
+1 KILL DIR
+2 SET DIR("A")="Type of List"
+3 SET DIR(0)="SO^A:Alphabetic;T:By Type"
+4 DO ^DIR
+5 if ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO EX
GOTO @Y
+6 ;
A ;Alphabetic
+1 SET BY="[ONCO CONTACT LIST-A]"
SET L=0
+2 SET DIC="^ONCO(165,"
SET L=0
DO EN1^DIP
+3 GOTO EX
+4 ;
T ;By Type
+1 SET BY="[ONCO CONTACT LIST-T]"
SET L=0
+2 SET DIC="^ONCO(165,"
SET L=0
DO EN1^DIP
+3 GOTO EX
+4 ;
4 ;Cleanup
+1 QUIT
+2 WRITE @IOF,?15,"************ Cleanout Unused Contacts ***********",!!
+3 GOTO DAC^ONCOFDP
+4 ;
UPHYCON ;Add/Edit/Update Physician contact
+1 ;W @IOF,
+2 WRITE !!!?15,"******* ADD/UPDATE PHYSICIAN CONTACT ***************"
+3 KILL DIR
+4 SET DIR("A")=" Select function"
+5 SET DIR(0)="SO^1:Add new physician contact;2:Edit NPI of existing physician contact;3:Delete existing physician contact"
+6 DO ^DIR
+7 if ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO EX
+8 IF Y=1
DO ADDPC
QUIT
+9 IF Y=2
DO EDPC
QUIT
+10 IF Y=3
DO DELPC
QUIT
+11 QUIT
+12 ;
ADDPC ;
+1 NEW ONCPHYNM,ONCNPIVL
+2 WRITE !
KILL DIR
SET DIR("A")="Enter physician name"
SET DIR(0)="F^3:30"
DO ^DIR
+3 if ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO EX
+4 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+5 SET ONCPHYNM=X
+6 IF $DATA(^ONCO(165,"B",ONCPHYNM))
WRITE !,"*** NOTE: '",ONCPHYNM,"' ALREADY IN CONTACT FILE - USE EDIT OPTION"
QUIT
ENTNPI WRITE !
KILL DIR
SET DIR("A")="Enter physician NPI"
SET DIR(0)="N"
+1 SET DIR("?")=" "
+2 SET DIR("?",1)=" Enter the NPI # for the physician contact."
+3 SET DIR("?",2)=" If you are unsure of the NPI #, you may use the National Provider"
+4 SET DIR("?",3)=" Identifier registry search to look up the NPI #:"
+5 SET DIR("?",4)=" https://npiregistry.cms.hhs.gov/search"
+6 DO ^DIR
+7 if ($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
GOTO EX
+8 SET ONCNPIVL=X
+9 IF ONCNPIVL'?10N
WRITE !,"NPI MUST BE 10 DIGITS"
GOTO ENTNPI
+10 IF $DATA(^ONCO(165,"F",ONCNPIVL))
Begin DoDot:1
+11 WRITE !,"NOTE: NPI # '",ONCNPIVL,"' ALREADY ASSIGNED TO THIS CONTACT(S): "
+12 FOR IENZZ=0:0
SET IENZZ=$ORDER(^ONCO(165,"F",ONCNPIVL,IENZZ))
if IENZZ'>0
QUIT
Begin DoDot:2
+13 WRITE !?8,$PIECE($GET(^ONCO(165,IENZZ,0)),"^",1)
End DoDot:2
End DoDot:1
+14 WRITE !!?6,"Adding to physician contacts:",!,?8,"Name: ",ONCPHYNM," NPI: ",ONCNPIVL
+15 WRITE !
KILL DIR
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
SET DIR(0)="Y"
DO ^DIR
+16 IF Y'=1
GOTO UPHYCON
+17 SET DIC="^ONCO(165,"
SET DIC(0)="L"
SET X=ONCPHYNM
+18 SET DIC("DR")="1///^S X=2;101///^S X=ONCNPIVL"
+19 DO FILE^DICN
+20 QUIT
+21 ;
EDPC ;
+1 SET DIC="^ONCO(165,"
SET DIC(0)="AEQZM"
+2 SET DIC("A")=" Select physician contact name: "
SET DIC("S")="I $P(^(0),U,2)=2"
+3 DO ^DIC
KILL DIC
if Y<0
GOTO EX
+4 SET DA=+Y
+5 SET DIE="^ONCO(165,"
SET DIC(0)="AELQMZ"
+6 SET DR=".01;101"
DO ^DIE
+7 QUIT
+8 ;
DELPC ;
+1 WRITE !
+2 SET DIC="^ONCO(165,"
+3 SET DIC(0)="AEZQ"
SET DIC("S")="I $P(^(0),U,2)=2"
+4 DO ^DIC
if Y<0
GOTO EX
+5 IF ($DATA(^ONCO(165,"ACP",+Y)))!($DATA(^ONCO(160,"AC",+Y)))!($DATA(^ONCO(160,"AE",+Y)))
WRITE !!?10,"You may only delete contacts which are not being used."
GOTO DELPC
+6 SET DA=+Y
SET DIK=DIC
WRITE !!?10,"Deleting Contact ",Y(0,0)
DO ^DIK
GOTO DELPC
+7 QUIT
+8 ;
EX ;Exit
+1 KILL ADDED,BY,D,DA,DIC,DIA,DIE,DIK,DIR,DIROUT,DIRUT,DLAYGO,DR,DTOUT,DUOUT
+2 KILL FIEN,L,LIEN,NEWIEN,OP,TMP,X,Y
+3 QUIT
+4 ;
HP ;THE CONTACT (160.06,2) EXECUTABLE HELP
+1 KILL DIC,DXS,DIOT
+2 DO ^ONCOXPC
+3 WRITE !
+4 QUIT
+5 ;
EEACOS ;[AC Enter/Edit Facility file]
+1 WRITE !
+2 WRITE !,?3,"E Edit an existing entry"
+3 WRITE !,?3,"A Add a new entry"
+4 WRITE !
KILL DIR
+5 SET DIR(0)="FAO^1:1"
SET DIR("A")="Select Enter/Edit Facility file Option: "
+6 SET DIR("?")=" Enter 'E' to edit an existing FACILITY or 'A' to add a new FACILITY"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
GOTO EX
+9 IF "AE"'[Y
GOTO EEACOS
+10 IF Y="A"
SET ADDED=0
DO ADD
if ADDED=0
GOTO EX
if ADDED=1
GOTO EEACOS
+11 IF Y="E"
DO EDIT
GOTO EX
+12 ;
EDIT ;Edit FACILITY file (160.19)
+1 WRITE !
SET (DIC,DIE)="^ONCO(160.19,"
SET DIC(0)="AELMQZ"
SET DLAYGO=160.19
DO ^DIC
+2 if Y=-1
QUIT
+3 SET DA=+Y
+4 WRITE !
SET DR=".01;.02;.03;.04;101"
DO ^DIE
+5 GOTO EDIT
+6 QUIT
ADD ;Add new FACILITY file (160.19) entry
+1 SET FIEN=$ORDER(^ONCO(160.19,"B",6999000,""))
IF FIEN=""
SET NEWIEN=6999000
+2 IF FIEN'=""
SET LIEN=6998999
FOR X=0:0
SET LIEN=$ORDER(^ONCO(160.19,"B",LIEN))
if LIEN=9999999
QUIT
SET TMP=LIEN
+3 IF $GET(TMP)
SET NEWIEN=TMP+1
+4 WRITE !!,"NEXT AVAILABLE LOCAL FIN NUMBER IS ",NEWIEN,"."
+5 WRITE !
+6 KILL DIR
+7 SET DIR(0)="Y"
SET DIR("A")="Do you want to add a new entry"
SET DIR("B")="NO"
+8 DO ^DIR
IF $DATA(DIRUT)!(Y=0)
QUIT
+9 KILL DD,DO
+10 SET DIC="^ONCO(160.19,"
SET DIC(0)="L"
SET X=NEWIEN
DO FILE^DICN
KILL DIC,DLAYGO,DO
+11 WRITE !
KILL DIE
SET DIE="^ONCO(160.19,"
SET DA=+Y
SET DR=".01;.02;.03;.04"
DO ^DIE
+12 SET ADDED=1
+13 QUIT
+14 ;
HELP ;EXCUTABLE HELP to display next available local FACILITY number
+1 SET FIEN=$ORDER(^ONCO(160.19,"B",6999000,""))
IF FIEN=""
SET NEWIEN=6999000
+2 IF FIEN'=""
SET LIEN=6998999
FOR X=0:0
SET LIEN=$ORDER(^ONCO(160.19,"B",LIEN))
if LIEN=9999999
QUIT
SET TMP=LIEN
+3 IF $GET(TMP)
SET NEWIEN=TMP+1
+4 WRITE !
+5 WRITE !?3,"If you wish to add a new facility, enter either the 7-digit"
+6 WRITE !?3,"(6020009-6953290) or 8-digit (10000000+) assigned COC FIN"
+7 WRITE !?3,"number."
+8 WRITE !
+9 WRITE !?3,"If the new facility does not have an assigned COC FIN number,"
+10 WRITE !?3,"use the next available local FIN number.",!
+11 WRITE !?3,"THE NEXT AVAILABLE LOCAL FIN NUMBER IS ",NEWIEN,".",!
+12 QUIT
