Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOFLF

ONCOFLF.m

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