- 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 Jan 18, 2025@03:26:12 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